1#!/usr/local/bin/perl -w 2# 3# SEC (Simple Event Correlator) 2.9.0 - sec 4# Copyright (C) 2000-2021 Risto Vaarandi 5# 6# This program is free software; you can redistribute it and/or 7# modify it under the terms of the GNU General Public License 8# as published by the Free Software Foundation; either version 2 9# of the License, or (at your option) any later version. 10# 11# This program is distributed in the hope that it will be useful, 12# but WITHOUT ANY WARRANTY; without even the implied warranty of 13# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14# GNU General Public License for more details. 15# 16# You should have received a copy of the GNU General Public License 17# along with this program; if not, write to the Free Software 18# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. 19# 20 21package main::SEC; 22 23# Parameters: par1 - perl code to be evaluated 24# par2 - if set to 0, the code will be evaluated in scalar 25# context; if 1, list context is used for evaluation 26# Action: calls eval() for the perl code par1, and returns an array with 27# the eval() return value(s). The first element of the array 28# indicates whether the code was evaluated successfully (i.e., 29# the compilation didn't fail). If code evaluation fails, the 30# first element of the return array contains the error string. 31 32sub call_eval { 33 34 my($code, $listcontext) = @_; 35 my($ok, @result); 36 37 $ok = 1; 38 39 if ($listcontext) { 40 @result = eval $code; 41 } else { 42 $result[0] = eval $code; 43 } 44 45 if ($@) { 46 $ok = 0; 47 chomp($result[0] = $@); 48 } 49 50 return ($ok, @result); 51 52} 53 54###################################################################### 55 56package main; 57 58use strict; 59 60##### List of global variables ##### 61 62use vars qw( 63 @actioncopyfunc 64 @actionsubstfunc 65 $blocksize 66 $bufpos 67 $bufsize 68 @calendar 69 %cfset2cfile 70 $check_timeout 71 %children 72 $childterm 73 $cleantime 74 @conffilepat 75 @conffiles 76 %config_ltimes 77 %config_mtimes 78 %config_options 79 %configuration 80 %context_list 81 %corr_list 82 $debuglevel 83 $debuglevelinc 84 $detach 85 $dumpdata 86 $dumpfile 87 $dumpfjson 88 $dumpfts 89 %dyninputfiles 90 @events 91 %event_buffer 92 $evstoresize 93 @execactionfunc 94 $fromstart 95 @groupnames 96 $help 97 @inputfilepat 98 @inputfiles 99 %inputsrc 100 @input_buffer 101 %input_buffers 102 @input_sources 103 $input_timeout 104 $intcontextname 105 $intcontexts 106 $intevents 107 $int_context 108 $JSONAVAIL 109 $jointbuf 110 $keepopen 111 $lastcleanuptime 112 $lastconfigload 113 $logfile 114 $loghandle 115 $logopen 116 @maincfiles 117 @matchegrpfunc 118 @matchfunc 119 @matchrulefunc 120 $openlog 121 %output_files 122 %output_tcpconn 123 %output_tcpsock 124 %output_udgram 125 %output_udpsock 126 %output_ustrconn 127 %output_ustream 128 @pending_events 129 $pidfile 130 %pmatch_cache 131 $poll_timeout 132 $processedlines 133 @processrulefunc 134 $quoting 135 $rcfile_status 136 @readbuffer 137 $refresh 138 $reopen_timeout 139 $ruleperf 140 $rwfifo 141 $SEC_COPYRIGHT 142 $SEC_LICENSE 143 $SEC_USAGE 144 $SEC_VERSION 145 $SYSLOGAVAIL 146 $sec_options 147 $sigreceived 148 $socket_timeout 149 $softrefresh 150 $startuptime 151 $syslogf 152 $syslogopen 153 $tail 154 %terminate 155 $testonly 156 $timeout_script 157 $timevar_update 158 $umask 159 $username 160 %variables 161 $version 162 $WIN32 163); 164 165 166##### Load modules and set some global variables ##### 167 168use POSIX qw(:errno_h :sys_wait_h SEEK_SET SEEK_CUR SEEK_END 169 setsid ctermid getpgrp tcgetpgrp setuid setgid strftime); 170use Getopt::Long; 171use Fcntl; 172use Socket; 173use IO::Handle; 174 175# check if Sys::Syslog and JSON::PP modules are available 176 177$SYSLOGAVAIL = eval { require Sys::Syslog }; 178$JSONAVAIL = eval { require JSON::PP }; 179 180# check if the platform is win32 181 182$WIN32 = ($^O =~ /win/i && $^O !~ /cygwin/i && $^O !~ /darwin/i); 183 184# set version and usage variables 185 186$SEC_VERSION = "SEC (Simple Event Correlator) 2.9.0"; 187$SEC_COPYRIGHT = "Copyright (C) 2000-2021 Risto Vaarandi"; 188 189$SEC_USAGE = qq!Usage: $0 [options] 190 191Options: 192 --conf=<file pattern> ... 193 --input=<file pattern>[=<context>] ... 194 --input-timeout=<input timeout> 195 --timeout-script=<timeout script> 196 --reopen-timeout=<reopen timeout> 197 --check-timeout=<check timeout> 198 --poll-timeout=<poll timeout> 199 --socket-timeout=<socket timeout> 200 --blocksize=<io block size> 201 --bufsize=<input buffer size> 202 --evstoresize=<event store size> 203 --cleantime=<clean time> 204 --log=<logfile> 205 --syslog=<facility> 206 --debug=<debuglevel> 207 --pid=<pidfile> 208 --dump=<dumpfile> 209 --user=<username> 210 --group=<groupname> ... 211 --umask=<mode> 212 --ruleperf, --noruleperf 213 --dumpfts, --nodumpfts 214 --dumpfjson, --nodumpfjson 215 --quoting, --noquoting 216 --tail, --notail 217 --fromstart, --nofromstart 218 --detach, --nodetach 219 --jointbuf, --nojointbuf 220 --keepopen, --nokeepopen 221 --rwfifo, --norwfifo 222 --childterm, --nochildterm 223 --intevents, --nointevents 224 --intcontexts, --nointcontexts 225 --testonly, --notestonly 226 --help, -? 227 --version 228!; 229 230$SEC_LICENSE = q! 231This program is free software; you can redistribute it and/or 232modify it under the terms of the GNU General Public License 233as published by the Free Software Foundation; either version 2 234of the License, or (at your option) any later version. 235 236This program is distributed in the hope that it will be useful, 237but WITHOUT ANY WARRANTY; without even the implied warranty of 238MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 239GNU General Public License for more details. 240 241You should have received a copy of the GNU General Public License 242along with this program; if not, write to the Free Software 243Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. 244!; 245 246 247##### List of internal constants ##### 248 249use constant INVALIDVALUE => -1; 250 251use constant SINGLE => 0; 252use constant SINGLE_W_SUPPRESS => 1; 253use constant SINGLE_W_SCRIPT => 2; 254use constant PAIR => 3; 255use constant PAIR_W_WINDOW => 4; 256use constant SINGLE_W_THRESHOLD => 5; 257use constant SINGLE_W_2_THRESHOLDS => 6; 258use constant EVENT_GROUP => 7; 259use constant SUPPRESS => 8; 260use constant CALENDAR => 9; 261use constant JUMP => 10; 262 263use constant SUBSTR => 0; 264use constant REGEXP => 1; 265use constant PERLFUNC => 2; 266use constant CACHED => 3; 267use constant NSUBSTR => 4; 268use constant NREGEXP => 5; 269use constant NPERLFUNC => 6; 270use constant NCACHED => 7; 271use constant TVALUE => 8; 272 273use constant DONTCONT => 0; 274use constant TAKENEXT => 1; 275use constant GOTO => 2; 276use constant ENDMATCH => 3; 277 278use constant NONE => 0; 279use constant LOGONLY => 1; 280use constant WRITE => 2; 281use constant WRITEN => 3; 282use constant CLOSEF => 4; 283use constant OWRITECL => 5; 284use constant UDGRAM => 6; 285use constant CLOSEUDGR => 7; 286use constant USTREAM => 8; 287use constant CLOSEUSTR => 9; 288use constant UDPSOCK => 10; 289use constant CLOSEUDP => 11; 290use constant TCPSOCK => 12; 291use constant CLOSETCP => 13; 292use constant SHELLCOMMAND => 14; 293use constant COMMANDEXEC => 15; 294use constant SPAWN => 16; 295use constant SPAWNEXEC => 17; 296use constant CSPAWN => 18; 297use constant CSPAWNEXEC => 19; 298use constant PIPE => 20; 299use constant PIPEEXEC => 21; 300use constant CREATECONTEXT => 22; 301use constant DELETECONTEXT => 23; 302use constant OBSOLETECONTEXT => 24; 303use constant SETCONTEXT => 25; 304use constant ALIAS => 26; 305use constant UNALIAS => 27; 306use constant ADD => 28; 307use constant PREPEND => 29; 308use constant FILL => 30; 309use constant REPORT => 31; 310use constant REPORTEXEC => 32; 311use constant COPYCONTEXT => 33; 312use constant EMPTYCONTEXT => 34; 313use constant POP => 35; 314use constant SHIFT => 36; 315use constant EXISTS => 37; 316use constant GETSIZE => 38; 317use constant GETALIASES => 39; 318use constant GETLIFETIME => 40; 319use constant SETLIFETIME => 41; 320use constant GETCTIME => 42; 321use constant SETCTIME => 43; 322use constant EVENT => 44; 323use constant TEVENT => 45; 324use constant CEVENT => 46; 325use constant RESET => 47; 326use constant GETWINPOS => 48; 327use constant SETWINPOS => 49; 328use constant ASSIGN => 50; 329use constant ASSIGNSQ => 51; 330use constant FREE => 52; 331use constant EVAL => 53; 332use constant CALL => 54; 333use constant LCALL => 55; 334use constant REWRITE => 56; 335use constant ADDINPUT => 57; 336use constant DROPINPUT => 58; 337use constant SIGEMUL => 59; 338use constant VARIABLESET => 60; 339use constant IF => 100; 340use constant WHILE => 101; 341use constant BREAK => 102; 342use constant CONTINUE => 103; 343 344use constant OPERAND => 0; 345use constant NEGATION => 1; 346use constant AND => 2; 347use constant OR => 3; 348use constant EXPRESSION => 4; 349use constant ECODE => 5; 350use constant CCODE => 6; 351use constant CCODE2 => 7; 352use constant VARSET => 8; 353 354use constant EXPRSYMBOL => "\0"; 355 356use constant LOG_WITHOUT_LEVEL => 0; 357use constant LOG_CRIT => 1; 358use constant LOG_ERR => 2; 359use constant LOG_WARN => 3; 360use constant LOG_NOTICE => 4; 361use constant LOG_INFO => 5; 362use constant LOG_DEBUG => 6; 363 364use constant SYSLOG_LEVELS => { 365 0 => "notice", 366 1 => "crit", 367 2 => "err", 368 3 => "warning", 369 4 => "notice", 370 5 => "info", 371 6 => "debug" 372}; 373 374use constant SEPARATOR => " | "; 375 376use constant TERMTIMEOUT => 3; 377use constant BATCHREADLIMIT => 8192; 378 379use constant SECEVENT_INT_CONTEXT => "SEC_INTERNAL_EVENT"; 380use constant SYNEVENT_INT_CONTEXT => "_INTERNAL_EVENT"; 381use constant FILEVENT_INT_CONTEXT_PREF => "_FILE_EVENT_"; 382 383use constant DEFAULT_POLLTIMEOUT => 0.1; 384use constant DEFAULT_SOCKETTIMEOUT => 60; 385use constant DEFAULT_BLOCKSIZE => 8192; 386use constant DEFAULT_CLEANTIME => 1; 387use constant DEFAULT_DUMPFILE => "/tmp/sec.dump"; 388 389 390############################################################### 391# ------------------------- FUNCTIONS ------------------------- 392############################################################### 393 394############################## 395# Functions related to logging 396############################## 397 398 399# Parameters: par1 - name of the logfile 400# Action: logfile will be opened. Filehandle of the logfile will be 401# saved to the global filehandle $loghandle. 402 403sub open_logfile { 404 405 my($logfile) = $_[0]; 406 407 if (open($loghandle, ">>$logfile")) { 408 select($loghandle); 409 $| = 1; 410 select(STDOUT); 411 $logopen = 1; 412 } else { 413 print STDERR "Can't open logfile $logfile ($!)\n"; 414 $logopen = 0; 415 } 416} 417 418 419# Parameters: par1 - syslog facility 420# Action: open connection to the system logger with the facility par1. 421 422sub open_syslog { 423 424 my($facility) = $_[0]; 425 my($progname); 426 427 $progname = $0; 428 $progname =~ s/.*\///; 429 430 eval { Sys::Syslog::openlog($progname, "pid", $facility) }; 431 432 if ($@) { 433 print STDERR "Can't connect to syslog ($@)\n"; 434 $syslogopen = 0; 435 return; 436 } 437 438 $syslogopen = 1; 439} 440 441 442# Parameters: par1 - severity of the log message 443# par2, par3, ... - strings to be logged 444# Action: if par1 is smaller or equal to the current logging level (i.e., 445# the message must be logged), then strings par2, par3, ... 446# will be equipped with timestamp and written to $loghandle and/or 447# forwarded to the system logger as a single line. If STDERR is 448# connected to terminal, message will also be written there. 449 450sub log_msg { 451 452 my($level) = shift(@_); 453 my($ltime, $msg); 454 455 if ($debuglevel < $level) { return; } 456 457 if (!$logopen && !$syslogopen && ! -t STDERR) { return; } 458 459 $msg = join(" ", @_); 460 461 if (-t STDERR) { print STDERR "$msg\n"; } 462 463 if ($logopen) { 464 $ltime = localtime(time()); 465 print $loghandle "$ltime: $msg\n"; 466 } 467 468 # if call to syslog() fails (e.g., because syslog daemon is going through 469 # restart), older versions of Sys::Syslog will die, thus we use eval 470 471 if ($syslogopen) { 472 eval { Sys::Syslog::syslog(SYSLOG_LEVELS->{$level}, $msg) }; 473 } 474 475} 476 477 478####################################################### 479# Functions related to configuration file(s) processing 480####################################################### 481 482 483# Parameters: par1, par2, .. - strings 484# Action: All 2-byte substrings in par1, par2, .. that denote special 485# symbols ("\n", "\t", ..) will be replaced with corresponding 486# special symbols 487 488sub subst_specchar { 489 490 my(%specchar, $string); 491 492 $specchar{"0"} = ""; 493 $specchar{"n"} = "\n"; 494 $specchar{"r"} = "\r"; 495 $specchar{"s"} = " "; 496 $specchar{"t"} = "\t"; 497 $specchar{"\\"} = "\\"; 498 499 foreach $string (@_) { 500 $string =~ s/\\(0|n|r|s|t|\\)/$specchar{$1}/g; 501 } 502 503} 504 505 506# Parameters: par1 - string that is checked for match variables 507# par2, .. - one or more tokens that match variables begin with 508# Action: return 1 if the string par1 contains match variables, 0 otherwise 509 510sub contains_matchvars { 511 512 my($string) = shift @_; 513 my($token, $string2, %subst); 514 515 # invoke subst_string() function for the input string and empty match 516 # value hash - if the string contains match variables, they are replaced 517 # with empty strings, and the result is different from the original string 518 519 foreach $token (@_) { 520 $string2 = $string; 521 subst_string(\%subst, $string2, $token); 522 if ($string ne $string2) { return 1; } 523 } 524 525 return 0; 526 527} 528 529 530# Parameters: par1 - reference to a context expression 531# par2, .. - one or more tokens that match variables begin with 532# Action: return 1 if expression par1 contains match variables, 0 otherwise 533 534sub volatile_context { 535 536 my($ref) = shift @_; 537 my($i, $j, $elem); 538 539 $i = 0; 540 $j = scalar(@{$ref}); 541 542 while ($i < $j) { 543 544 if ($ref->[$i] == OPERAND || $ref->[$i] == ECODE 545 || $ref->[$i] == VARSET) { 546 if (contains_matchvars($ref->[$i+1], @_)) { return 1; } 547 $i += 2; 548 } 549 550 elsif ($ref->[$i] == EXPRESSION) { 551 if (volatile_context($ref->[$i+1], @_)) { return 1; } 552 $i += 2; 553 } 554 555 elsif ($ref->[$i] == CCODE || $ref->[$i] == CCODE2) { 556 foreach $elem (@{$ref->[$i+1]}) { 557 if (contains_matchvars($elem, @_)) { return 1; } 558 } 559 $i += 3; 560 } 561 562 else { ++$i; } 563 564 } 565 566 return 0; 567 568} 569 570 571# Parameters: par1 - expression 572# par2 - reference to an array 573# Action: parentheses and their contents will be replaced with special 574# symbols EXPRSYMBOL in par 1. The expressions inside parentheses 575# will be returned in par2. Previous content of the array par2 576# is erased. If par1 was parsed successfully, the modified par1 577# will be returned, otherwise undef is returned. 578 579sub replace_subexpr { 580 581 my($expression, $expr_ref) = @_; 582 my($i, $j, $l, $pos); 583 my($char, $prev); 584 585 @{$expr_ref} = (); 586 587 $i = 0; 588 $j = 0; 589 $l = length($expression); 590 $pos = undef; 591 $prev = ""; 592 593 while ($i < $l) { 594 595 # process expression par1 from the start and inspect every symbol, 596 # adding 1 to $j for every '(' and subtracting 1 for every ')'; 597 # if a parenthesis is masked with a backslash, it is ignored 598 599 $char = substr($expression, $i, 1); 600 601 if ($prev ne "\\") { 602 if ($char eq "(") { ++$j; } elsif ($char eq ")") { --$j; } 603 } 604 605 # After observing first '(' save its position to $pos; 606 # after observing its counterpart ')' replace everything 607 # from '(' to ')' with EXPRSYMBOL (including possible nested 608 # expressions), and save the content of parentheses; 609 # if at some point $j becomes negative, the parentheses must 610 # be unbalanced 611 612 if ($j == 1 && !defined($pos)) { $pos = $i; } 613 614 elsif ($j == 0 && defined($pos)) { 615 616 # take symbols starting from position $pos+1 (next symbol after 617 # '(') up to position $i-1 (the symbol before ')'), and save 618 # the symbols to array 619 620 push @{$expr_ref}, substr($expression, $pos + 1, $i - $pos - 1); 621 622 # replace both the parentheses and the symbols between them 623 # with EXPRSYMBOL 624 625 substr($expression, $pos, $i - $pos + 1) = EXPRSYMBOL; 626 627 # set the variables according to changes in expression 628 629 $i = $pos; 630 $l = length($expression); 631 $pos = undef; 632 $char = ""; 633 634 } 635 636 elsif ($j < 0) { return undef; } # extra ')' was found 637 638 $prev = $char; 639 640 ++$i; 641 642 } 643 644 # if the parsing ended with non-zero $j, the parentheses were unbalanced 645 646 if ($j == 0) { return $expression; } else { return undef; } 647 648} 649 650 651# Parameters: par1 - continue value (string) 652# par2 - the name of the configuration file 653# par3 - line number in configuration file 654# Action: par1 will be analyzed and the integer continue value with 655# an optional jump label will be returned. 656# If errors are found when analyzing par1, error message 657# about improper line par3 in configuration file will be logged. 658 659sub analyze_continue { 660 661 my($continue, $conffile, $lineno) = @_; 662 663 if (uc($continue) eq "TAKENEXT") { return (TAKENEXT, undef); } 664 elsif (uc($continue) eq "DONTCONT") { return (DONTCONT, undef); } 665 elsif (uc($continue) eq "ENDMATCH") { return (ENDMATCH, undef); } 666 elsif ($continue =~ /^goto\s+(.*\S)/i) { return (GOTO, $1); } 667 668 log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 669 "Invalid continue value '$continue'"); 670 return INVALIDVALUE; 671 672} 673 674 675# Parameters: par1 - pattern type (string) 676# par2 - pattern 677# par3 - the name of the configuration file 678# par4 - line number in configuration file 679# par5 - if we are dealing with the second pattern of Pair* 680# rule, par5 contains the type of the first pattern 681# Action: par1 and par2 will be analyzed and tuple of integers 682# (pattern type, line count, compiled pattern) will be returned 683# (line count shows how many lines the pattern is designed to match). 684# If pattern is a second regular expression pattern of Pair rule which 685# contains match variables, the expression will not be compiled and 686# a corresponding flag is added to the return list. 687# If errors are found when analyzing par1 and par2, error message 688# about improper line par4 in configuration file will be logged. 689 690sub analyze_pattern { 691 692 my($pattype, $pat, $conffile, $lineno, $fptype) = @_; 693 my($negate, $lines, $pat2, $ncomp); 694 my($evalok, $retval); 695 696 if ($pattype =~ /^(n?)regexp(?:0*([1-9][0-9]*))?$/i) { 697 698 if (length($1)) { $negate = 1; } else { $negate = 0; } 699 if (defined($2)) { $lines = $2; } else { $lines = 1; } 700 701 if ($bufsize && $lines > $bufsize) { 702 log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 703 "Pattern type '$pattype' is designed to match $lines lines,", 704 "please set --bufsize command line option to at least $lines"); 705 return (INVALIDVALUE, INVALIDVALUE, INVALIDVALUE); 706 } 707 708 if (!defined($fptype) || $fptype == TVALUE || $fptype == SUBSTR || 709 $fptype == NSUBSTR || !contains_matchvars($pat, '$')) { 710 711 $pat2 = eval { qr/$pat/ }; 712 713 if ($@) { 714 log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 715 "Invalid regular expression '$pat':", $@); 716 return (INVALIDVALUE, INVALIDVALUE, INVALIDVALUE); 717 } 718 719 } else { 720 $pat2 = $pat; 721 $ncomp = 1; 722 } 723 724 if ($negate) { return (NREGEXP, $lines, $pat2, $ncomp); } 725 else { return (REGEXP, $lines, $pat2, $ncomp); } 726 727 } elsif ($pattype =~ /^(n?)substr(?:0*([1-9][0-9]*))?$/i) { 728 729 if (length($1)) { $negate = 1; } else { $negate = 0; } 730 if (defined($2)) { $lines = $2; } else { $lines = 1; } 731 732 if ($bufsize && $lines > $bufsize) { 733 log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 734 "Pattern type '$pattype' is designed to match $lines lines,", 735 "please set --bufsize command line option to at least $lines"); 736 return (INVALIDVALUE, INVALIDVALUE, INVALIDVALUE); 737 } 738 739 subst_specchar($pat); 740 741 if ($negate) { return (NSUBSTR, $lines, $pat); } 742 else { return (SUBSTR, $lines, $pat); } 743 744 } elsif ($pattype =~ /^(n?)perlfunc(?:0*([1-9][0-9]*))?$/i) { 745 746 if (length($1)) { $negate = 1; } else { $negate = 0; } 747 if (defined($2)) { $lines = $2; } else { $lines = 1; } 748 749 if ($bufsize && $lines > $bufsize) { 750 log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 751 "Pattern type '$pattype' is designed to match $lines lines,", 752 "please set --bufsize command line option to at least $lines"); 753 return (INVALIDVALUE, INVALIDVALUE, INVALIDVALUE); 754 } 755 756 ($evalok, $retval) = SEC::call_eval($pat, 0); 757 758 if (!$evalok || !defined($retval) || ref($retval) ne "CODE") { 759 log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 760 "Invalid function '$pat', eval didn't return a code reference:", 761 defined($retval)?"$retval":"undef"); 762 return (INVALIDVALUE, INVALIDVALUE, INVALIDVALUE); 763 } 764 765 if ($negate) { return (NPERLFUNC, $lines, $retval); } 766 else { return (PERLFUNC, $lines, $retval); } 767 768 } elsif ($pattype =~ /^(n?)cached$/i) { 769 770 if (length($1)) { $negate = 1; } else { $negate = 0; } 771 772 if ($pat !~ /^[[:alpha:]]\w*$/) { 773 log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 774 "Invalid cached pattern name '$pat':", 775 "the name does not have the form", 776 "<letter>[<letter>|<digit>|<underscore>]..."); 777 return (INVALIDVALUE, INVALIDVALUE, INVALIDVALUE); 778 } 779 780 if ($negate) { return (NCACHED, 1, $pat); } 781 else { return (CACHED, 1, $pat); } 782 783 } elsif ($pattype =~ /^tvalue$/i) { 784 785 if (uc($pat) ne "TRUE" && uc($pat) ne "FALSE") { 786 log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 787 "Invalid truth value '$pat'"); 788 return (INVALIDVALUE, INVALIDVALUE, INVALIDVALUE); 789 } 790 791 return (TVALUE, 1, uc($pat) eq "TRUE"); 792 793 } 794 795 log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 796 "Invalid pattern type '$pattype'"); 797 return (INVALIDVALUE, INVALIDVALUE, INVALIDVALUE); 798 799} 800 801 802# Parameters: par1 - pattern type 803# par2 - variable map (string) 804# par3 - reference to the variable map hash 805# par4 - the name of the configuration file 806# par5 - line number in configuration file 807# Action: variable map par2 will be analyzed and saved into the hash par3. 808# If no errors are detected, 1 is returned. Otherwise error message 809# about improper line par5 in configuration file will be logged, 810# and 0 is returned. If the pattern type does not assume a variable 811# map (e.g., TValue), par3 will be set to empty hash, a warning is 812# logged and 1 is returned. 813 814sub analyze_varmap { 815 816 my($pattype, $varmap, $maphash_ref, $conffile, $lineno) = @_; 817 my(@varmap, $mapping); 818 819 %{$maphash_ref} = (); 820 821 if ($pattype != REGEXP && $pattype != PERLFUNC) { 822 log_msg(LOG_WARN, "Rule in $conffile at line $lineno:", 823 "Variable maps are supported for RegExp and PerlFunc patterns only,", 824 "ignoring variable map '$varmap'"); 825 return 1; 826 } 827 828 @varmap = split(/\s*;\s*/, $varmap); 829 830 foreach $mapping (@varmap) { 831 if ($mapping =~ /^\s*([[:alpha:]]\w*)(?:\s*=\s*0*([0-9]+))?\s*$/) { 832 $maphash_ref->{"$1"} = $2; 833 } else { 834 log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 835 "Invalid variable map '$varmap':", 836 "the variable mapping '$mapping' does not have the form", 837 "<letter>[<letter>|<digit>|<underscore>]... [= <number>]"); 838 return 0; 839 } 840 } 841 842 return 1; 843 844} 845 846 847# Parameters: par1 - event group pattern type (string) 848# par2 - event group pattern 849# par3 - the name of the configuration file 850# par4 - line number in configuration file 851# Action: par1 and par2 will be analyzed and tuple of integers 852# (pattern type, compiled pattern) will be returned. 853# If errors are found when analyzing par1 and par2, error message 854# about improper line par4 in configuration file will be logged. 855 856sub analyze_eventgroup_pattern { 857 858 my($pattype, $pat, $conffile, $lineno) = @_; 859 my($negate, $pat2); 860 my($evalok, $retval); 861 862 if ($pattype =~ /^(n?)regexp$/i) { 863 864 if (length($1)) { $negate = 1; } else { $negate = 0; } 865 866 $pat2 = eval { qr/$pat/ }; 867 868 if ($@) { 869 log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 870 "Invalid regular expression '$pat':", $@); 871 return (INVALIDVALUE, INVALIDVALUE); 872 } 873 874 if ($negate) { return (NREGEXP, $pat2); } 875 else { return (REGEXP, $pat2); } 876 877 } elsif ($pattype =~ /^(n?)substr$/i) { 878 879 if (length($1)) { $negate = 1; } else { $negate = 0; } 880 881 subst_specchar($pat); 882 883 if ($negate) { return (NSUBSTR, $pat); } 884 else { return (SUBSTR, $pat); } 885 886 } elsif ($pattype =~ /^(n?)perlfunc$/i) { 887 888 if (length($1)) { $negate = 1; } else { $negate = 0; } 889 890 ($evalok, $retval) = SEC::call_eval($pat, 0); 891 892 if (!$evalok || !defined($retval) || ref($retval) ne "CODE") { 893 log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 894 "Invalid function '$pat', eval didn't return a code reference:", 895 defined($retval)?"$retval":"undef"); 896 return (INVALIDVALUE, INVALIDVALUE); 897 } 898 899 if ($negate) { return (NPERLFUNC, $retval); } 900 else { return (PERLFUNC, $retval); } 901 902 } 903 904 log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 905 "Invalid event group pattern type '$pattype'"); 906 return (INVALIDVALUE, INVALIDVALUE); 907 908} 909 910 911# Parameters: par1, par2, .. - strings 912# Action: for each string, remove the outer pair of parens and backslashes 913# from the front of other parens 914 915sub process_action_parens { 916 917 my($string); 918 919 foreach $string (@_) { 920 if ($string =~ /^\s*\(\s*(.*?)\s*\)\s*$/) { $string = $1; } 921 $string =~ s/\\([()])/$1/g; 922 } 923} 924 925 926# Parameters: par1 - action 927# par2 - the name of the configuration file 928# par3 - line number in configuration file 929# par4 - rule ID 930# par5 - action with masked subexpressions 931# par6 - list of subexpressions 932# Action: par1 will be analyzed and pair of integers 933# (action type, action description) will be returned. If errors 934# are found when analyzing par1, error message about improper 935# line par3 in configuration file will be logged. 936 937sub analyze_action { 938 939 my($action, $conffile, $lineno, $ruleid, $action2, $list) = @_; 940 my($keyword, $file, $fpos, $peer, $cmdline, $signal); 941 my($sign, $rule, $count); 942 my($actionlist, @action); 943 my($actionlist2, @action2); 944 my($createafter, $event, $timestamp); 945 my($lifetime, $context, $alias, $entry); 946 my($variable, $value, $code, $codeptr, $params, $evalok, $op); 947 948 if ($action =~ /^none$/i) { return NONE; } 949 950 elsif ($action =~ /^logonly(?:\s+(.*\S))?$/i) { 951 952 $event = defined($1)?$1:""; 953 process_action_parens($event); 954 if (!length($event)) { $event = "%s"; } 955 956 return (LOGONLY, $event); 957 } 958 959 elsif ($action =~ /^(write|writen|owritecl|udgram|ustream)\s+(\S+)(?:\s+(.*\S))?$/i) { 960 961 $keyword = lc($1); 962 $file = $2; 963 $event = defined($3)?$3:""; 964 965 if ($WIN32 && ($keyword eq "udgram" || $keyword eq "ustream")) { 966 log_msg(LOG_ERR, "$keyword action is not supported on Win32"); 967 return INVALIDVALUE; 968 } 969 970 process_action_parens($file, $event); 971 972 if (!length($file)) { 973 log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 974 "Empty filename given for $keyword action"); 975 return INVALIDVALUE; 976 } 977 978 if (!length($event)) { $event = "%s"; } 979 980 if ($keyword eq "write") { return (WRITE, $file, $event); } 981 elsif ($keyword eq "writen") { return (WRITEN, $file, $event); } 982 elsif ($keyword eq "owritecl") { return (OWRITECL, $file, $event); } 983 elsif ($keyword eq "udgram") { return (UDGRAM, $file, $event); } 984 else { return (USTREAM, $file, $event); } 985 } 986 987 elsif ($action =~ /^(closef|closeudgr|closeustr|dropinput)\s+(\S+)$/i) { 988 989 $keyword = lc($1); 990 $file = $2; 991 992 if ($WIN32 && ($keyword eq "closeudgr" || $keyword eq "closeustr")) { 993 log_msg(LOG_ERR, "$keyword action is not supported on Win32"); 994 return INVALIDVALUE; 995 } 996 997 process_action_parens($file); 998 999 if (!length($file)) { 1000 log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 1001 "Empty filename given for $keyword action"); 1002 return INVALIDVALUE; 1003 } 1004 1005 if ($keyword eq "closef") { return (CLOSEF, $file); } 1006 elsif ($keyword eq "closeudgr") { return (CLOSEUDGR, $file); } 1007 elsif ($keyword eq "closeustr") { return (CLOSEUSTR, $file); } 1008 else { return (DROPINPUT, $file); } 1009 } 1010 1011 elsif ($action =~ /^(udpsock|tcpsock)\s+(\S+)(?:\s+(.*\S))?$/i) { 1012 1013 $keyword = lc($1); 1014 $peer = $2; 1015 $event = defined($3)?$3:""; 1016 1017 process_action_parens($peer, $event); 1018 1019 if (!length($peer)) { 1020 log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 1021 "Empty peername given for $keyword action"); 1022 return INVALIDVALUE; 1023 } 1024 1025 if (!length($event)) { $event = "%s"; } 1026 1027 if ($keyword eq "udpsock") { return (UDPSOCK, $peer, $event); } 1028 else { return (TCPSOCK, $peer, $event); } 1029 } 1030 1031 elsif ($action =~ /^(closeudp|closetcp)\s+(\S+)$/i) { 1032 1033 $keyword = lc($1); 1034 $peer = $2; 1035 1036 process_action_parens($peer); 1037 1038 if (!length($peer)) { 1039 log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 1040 "Empty peername given for $keyword action"); 1041 return INVALIDVALUE; 1042 } 1043 1044 if ($keyword eq "closeudp") { return (CLOSEUDP, $peer); } 1045 else { return (CLOSETCP, $peer); } 1046 } 1047 1048 elsif ($action =~ /^(shellcmd|cmdexec)\s+(.*\S)$/i) { 1049 1050 $keyword = lc($1); 1051 $cmdline = $2; 1052 process_action_parens($cmdline); 1053 1054 if (!length($cmdline)) { 1055 log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 1056 "Empty commandline given for $keyword action"); 1057 return INVALIDVALUE; 1058 } 1059 1060 if ($keyword eq "shellcmd") { return (SHELLCOMMAND, $cmdline); } 1061 else { return (COMMANDEXEC, [ split(' ', $cmdline) ]); } 1062 } 1063 1064 elsif ($action =~ /^(spawn|spawnexec)\s+(.*\S)$/i) { 1065 1066 $keyword = lc($1); 1067 $cmdline = $2; 1068 1069 if ($WIN32) { 1070 log_msg(LOG_ERR, "$keyword action is not supported on Win32"); 1071 return INVALIDVALUE; 1072 } 1073 1074 process_action_parens($cmdline); 1075 1076 if (!length($cmdline)) { 1077 log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 1078 "Empty commandline given for $keyword action"); 1079 return INVALIDVALUE; 1080 } 1081 1082 if ($keyword eq "spawn") { return (SPAWN, $cmdline); } 1083 else { return (SPAWNEXEC, [ split(' ', $cmdline) ]); } 1084 } 1085 1086 elsif ($action =~ /^(cspawn|cspawnexec)\s+(\S+)\s+(.*\S)$/i) { 1087 1088 $keyword = lc($1); 1089 $context = $2; 1090 $cmdline = $3; 1091 1092 if ($WIN32) { 1093 log_msg(LOG_ERR, "$keyword action is not supported on Win32"); 1094 return INVALIDVALUE; 1095 } 1096 1097 process_action_parens($context, $cmdline); 1098 1099 if (!length($context)) { 1100 log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 1101 "Empty context name given for $keyword action"); 1102 return INVALIDVALUE; 1103 } 1104 1105 if (!length($cmdline)) { 1106 log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 1107 "Empty commandline given for $keyword action"); 1108 return INVALIDVALUE; 1109 } 1110 1111 if ($keyword eq "cspawn") { return (CSPAWN, $context, $cmdline); } 1112 else { return (CSPAWNEXEC, $context, [ split(' ', $cmdline) ]); } 1113 } 1114 1115 elsif ($action =~ /^(pipe|pipeexec)\s+'([^']*)'(?:\s+(.*\S))?$/i) { 1116 1117 $keyword = lc($1); 1118 $event = $2; 1119 $cmdline = defined($3)?$3:""; 1120 1121 process_action_parens($event, $cmdline); 1122 1123 if (!length($event)) { $event = "%s"; } 1124 1125 # note that if commandline is not provided, $cmdline is set to 1126 # empty string, and in this case split() produces an empty list 1127 1128 if ($keyword eq "pipe") { return (PIPE, $event, $cmdline); } 1129 else { return (PIPEEXEC, $event, [ split(' ', $cmdline) ]); } 1130 } 1131 1132 elsif ($action =~ /^create(?:\s+(\S+)(?:\s+(\S+)(?:\s+(.*\S))?)?)?$/i) { 1133 1134 $context = defined($1)?$1:""; 1135 $lifetime = defined($2)?$2:""; 1136 $actionlist = defined($3)?$3:""; 1137 1138 process_action_parens($context, $lifetime); 1139 1140 # strip outer parentheses from actionlist if they exist 1141 if ($actionlist =~ /^\s*\(\s*(.*?)\s*\)\s*$/) { $actionlist = $1; } 1142 1143 if (!length($context)) { $context = "%s"; } 1144 if (!length($lifetime)) { $lifetime = 0; } 1145 1146 if (length($actionlist)) { 1147 if (!analyze_actionlist($actionlist, \@action, 1148 $conffile, $lineno, $ruleid)) { return INVALIDVALUE; } 1149 return (CREATECONTEXT, $context, $lifetime, [ @action ]); 1150 } 1151 1152 return (CREATECONTEXT, $context, $lifetime, []); 1153 } 1154 1155 elsif ($action =~ /^(delete|obsolete|unalias)(?:\s+(\S+))?$/i) { 1156 1157 $keyword = lc($1); 1158 $context = defined($2)?$2:""; 1159 process_action_parens($context); 1160 if (!length($context)) { $context = "%s"; } 1161 1162 if ($keyword eq "delete") { return (DELETECONTEXT, $context); } 1163 elsif ($keyword eq "obsolete") { return (OBSOLETECONTEXT, $context); } 1164 else { return (UNALIAS, $context); } 1165 } 1166 1167 elsif ($action =~ /^set\s+(\S+)\s+(\S+)(?:\s+(.*\S))?$/i) { 1168 1169 $context = $1; 1170 $lifetime = $2; 1171 $actionlist = defined($3)?$3:""; 1172 1173 process_action_parens($context, $lifetime); 1174 1175 # strip outer parentheses from actionlist if they exist 1176 if ($actionlist =~ /^\s*\(\s*(.*?)\s*\)\s*$/) { $actionlist = $1; } 1177 1178 if (!length($context)) { 1179 log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 1180 "Empty context name given for set action"); 1181 return INVALIDVALUE; 1182 } 1183 1184 if (!length($lifetime)) { 1185 log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 1186 "Empty lifetime given for set action"); 1187 return INVALIDVALUE; 1188 } 1189 1190 if (length($actionlist)) { 1191 if (!analyze_actionlist($actionlist, \@action, 1192 $conffile, $lineno, $ruleid)) { return INVALIDVALUE; } 1193 return (SETCONTEXT, $context, $lifetime, [ @action ]); 1194 } 1195 1196 return (SETCONTEXT, $context, $lifetime, []); 1197 } 1198 1199 elsif ($action =~ /^alias\s+(\S+)(?:\s+(\S+))?$/i) { 1200 1201 $context = $1; 1202 $alias = defined($2)?$2:""; 1203 process_action_parens($context, $alias); 1204 1205 if (!length($context)) { 1206 log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 1207 "Empty context name given for alias action"); 1208 return INVALIDVALUE; 1209 } 1210 1211 if (!length($alias)) { $alias = "%s"; } 1212 1213 return (ALIAS, $context, $alias); 1214 } 1215 1216 elsif ($action =~ /^(add|prepend|fill)\s+(\S+)(?:\s+(.*\S))?$/i) { 1217 1218 $keyword = lc($1); 1219 $context = $2; 1220 $event = defined($3)?$3:""; 1221 process_action_parens($context, $event); 1222 1223 if (!length($context)) { 1224 log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 1225 "Empty context name given for $keyword action"); 1226 return INVALIDVALUE; 1227 } 1228 1229 if (!length($event)) { $event = "%s"; } 1230 1231 if ($keyword eq "add") { return (ADD, $context, $event); } 1232 elsif ($keyword eq "prepend") { return (PREPEND, $context, $event); } 1233 else { return (FILL, $context, $event); } 1234 } 1235 1236 elsif ($action =~ /^(report|reportexec)\s+(\S+)(?:\s+(.*\S))?$/i) { 1237 1238 $keyword = lc($1); 1239 $context = $2; 1240 $cmdline = defined($3)?$3:""; 1241 1242 process_action_parens($context, $cmdline); 1243 1244 if (!length($context)) { 1245 log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 1246 "Empty context name given for $keyword action"); 1247 return INVALIDVALUE; 1248 } 1249 1250 # note that if commandline is not provided, $cmdline is set to 1251 # empty string, and in this case split() produces an empty list 1252 1253 if ($keyword eq "report") { return (REPORT, $context, $cmdline); } 1254 else { return (REPORTEXEC, $context, [ split(' ', $cmdline) ]); } 1255 } 1256 1257 elsif ($action =~ /^(copy|pop|shift)\s+(\S+)\s+(\S+)$/i) { 1258 1259 $keyword = lc($1); 1260 $context = $2; 1261 $variable = $3; 1262 process_action_parens($context); 1263 1264 if (!length($context)) { 1265 log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 1266 "Empty context name given for $keyword action"); 1267 return INVALIDVALUE; 1268 } 1269 1270 if ($variable !~ /^%[[:alpha:]]\w*$/) { 1271 log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 1272 "Variable $variable does not have the form", 1273 "%<letter>[<letter>|<digit>|<underscore>]..."); 1274 return INVALIDVALUE; 1275 } 1276 1277 if ($keyword eq "copy") { 1278 return (COPYCONTEXT, $context, substr($variable, 1)); 1279 } elsif ($keyword eq "pop") { 1280 return (POP, $context, substr($variable, 1)); 1281 } else { return (SHIFT, $context, substr($variable, 1)); } 1282 } 1283 1284 elsif ($action =~ /^empty\s+(\S+)(?:\s+(\S+))?$/i) { 1285 1286 $context = $1; 1287 $variable = defined($2)?$2:""; 1288 process_action_parens($context); 1289 1290 if (!length($context)) { 1291 log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 1292 "Empty context name given for empty action"); 1293 return INVALIDVALUE; 1294 } 1295 1296 if (length($variable) && $variable !~ /^%[[:alpha:]]\w*$/) { 1297 log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 1298 "Variable $variable does not have the form", 1299 "%<letter>[<letter>|<digit>|<underscore>]..."); 1300 return INVALIDVALUE; 1301 } 1302 1303 if (!length($variable)) { return (EMPTYCONTEXT, $context, ""); } 1304 1305 return (EMPTYCONTEXT, $context, substr($variable, 1)); 1306 } 1307 1308 elsif ($action =~ /^(exists|getsize|getaliases|getltime|getctime)\s+(\S+)\s+(\S+)$/i) { 1309 1310 $keyword = lc($1); 1311 $variable = $2; 1312 $context = $3; 1313 process_action_parens($context); 1314 1315 if ($variable !~ /^%[[:alpha:]]\w*$/) { 1316 log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 1317 "Variable $variable does not have the form", 1318 "%<letter>[<letter>|<digit>|<underscore>]..."); 1319 return INVALIDVALUE; 1320 } 1321 1322 if (!length($context)) { 1323 log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 1324 "Empty context name given for $keyword action"); 1325 return INVALIDVALUE; 1326 } 1327 1328 if ($keyword eq "exists") { 1329 return (EXISTS, substr($variable, 1), $context); 1330 } elsif ($keyword eq "getsize") { 1331 return (GETSIZE, substr($variable, 1), $context); 1332 } elsif ($keyword eq "getaliases") { 1333 return (GETALIASES, substr($variable, 1), $context); 1334 } elsif ($keyword eq "getltime") { 1335 return (GETLIFETIME, substr($variable, 1), $context); 1336 } else { return (GETCTIME, substr($variable, 1), $context); } 1337 } 1338 1339 elsif ($action =~ /^setltime\s+(\S+)(?:\s+(\S+))?$/i) { 1340 1341 $context = $1; 1342 $lifetime = defined($2)?$2:""; 1343 process_action_parens($context, $lifetime); 1344 1345 if (!length($context)) { 1346 log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 1347 "Empty context name given for setltime action"); 1348 return INVALIDVALUE; 1349 } 1350 1351 if (!length($lifetime)) { $lifetime = 0; } 1352 1353 return (SETLIFETIME, $context, $lifetime); 1354 } 1355 1356 elsif ($action =~ /^setctime\s+(\S+)\s+(\S+)$/i) { 1357 1358 $timestamp = $1; 1359 $context = $2; 1360 process_action_parens($timestamp, $context); 1361 1362 if (!length($timestamp)) { 1363 log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 1364 "Empty timestamp given for setctime action"); 1365 return INVALIDVALUE; 1366 } 1367 1368 if (!length($context)) { 1369 log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 1370 "Empty context name given for setctime action"); 1371 return INVALIDVALUE; 1372 } 1373 1374 return (SETCTIME, $timestamp, $context); 1375 } 1376 1377 elsif ($action =~ /^event(?:\s+0*([0-9]+))?(?:\s+(.*\S))?$/i) { 1378 1379 $createafter = defined($1)?$1:""; 1380 $event = defined($2)?$2:""; 1381 process_action_parens($event); 1382 1383 if (!length($createafter)) { $createafter = 0; } 1384 if (!length($event)) { $event = "%s"; } 1385 1386 return (EVENT, $createafter, $event); 1387 } 1388 1389 elsif ($action =~ /^tevent\s+(\S+)(?:\s+(.*\S))?$/i) { 1390 1391 $createafter = $1; 1392 $event = defined($2)?$2:""; 1393 process_action_parens($createafter, $event); 1394 1395 if (!length($createafter)) { 1396 log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 1397 "Empty time offset given for tevent action"); 1398 return INVALIDVALUE; 1399 } 1400 1401 if (!length($event)) { $event = "%s"; } 1402 1403 return (TEVENT, $createafter, $event); 1404 } 1405 1406 elsif ($action =~ /^cevent\s+(\S+)\s+(\S+)(?:\s+(.*\S))?$/i) { 1407 1408 $context = $1; 1409 $createafter = $2; 1410 $event = defined($3)?$3:""; 1411 1412 process_action_parens($context, $createafter, $event); 1413 1414 if (!length($context)) { 1415 log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 1416 "Empty context name given for cevent action"); 1417 return INVALIDVALUE; 1418 } 1419 1420 if (!length($createafter)) { 1421 log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 1422 "Empty time offset given for cevent action"); 1423 return INVALIDVALUE; 1424 } 1425 1426 if (!length($event)) { $event = "%s"; } 1427 1428 return (CEVENT, $context, $createafter, $event); 1429 } 1430 1431 elsif ($action =~ /^reset(?:\s+([+-]?)0*([0-9]+))?(?:\s+(.*\S))?$/i) { 1432 1433 $sign = defined($1)?$1:""; 1434 $rule = defined($2)?$2:""; 1435 $event = defined($3)?$3:""; 1436 1437 process_action_parens($event); 1438 1439 if (length($rule)) { 1440 if ($sign eq "+") { $rule = $ruleid + $rule; } 1441 elsif ($sign eq "-") { $rule = $ruleid - $rule; } 1442 elsif (!$rule) { $rule = $ruleid; } 1443 else { --$rule; } 1444 } else { $rule = ""; } 1445 1446 if (!length($event)) { $event = "%s"; } 1447 1448 return (RESET, $conffile, $rule, $event); 1449 } 1450 1451 elsif ($action =~ /^getwpos\s+(\S+)\s+([+-]?)0*([0-9]+)(?:\s+(.*\S))?$/i) { 1452 1453 $variable = $1; 1454 $sign = $2; 1455 $rule = $3; 1456 $event = defined($4)?$4:""; 1457 1458 process_action_parens($event); 1459 1460 if ($variable !~ /^%[[:alpha:]]\w*$/) { 1461 log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 1462 "Variable $variable does not have the form", 1463 "%<letter>[<letter>|<digit>|<underscore>]..."); 1464 return INVALIDVALUE; 1465 } 1466 1467 if ($sign eq "+") { $rule = $ruleid + $rule; } 1468 elsif ($sign eq "-") { $rule = $ruleid - $rule; } 1469 elsif (!$rule) { $rule = $ruleid; } 1470 else { --$rule; } 1471 1472 if (!length($event)) { $event = "%s"; } 1473 1474 return (GETWINPOS, substr($variable, 1), $conffile, $rule, $event); 1475 } 1476 1477 elsif ($action =~ /^setwpos\s+(\S+)\s+([+-]?)0*([0-9]+)(?:\s+(.*\S))?$/i) { 1478 1479 $timestamp = $1; 1480 $sign = $2; 1481 $rule = $3; 1482 $event = defined($4)?$4:""; 1483 1484 process_action_parens($timestamp, $event); 1485 1486 if ($sign eq "+") { $rule = $ruleid + $rule; } 1487 elsif ($sign eq "-") { $rule = $ruleid - $rule; } 1488 elsif (!$rule) { $rule = $ruleid; } 1489 else { --$rule; } 1490 1491 if (!length($timestamp)) { 1492 log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 1493 "Empty timestamp given for setwpos action"); 1494 return INVALIDVALUE; 1495 } 1496 1497 if (!length($event)) { $event = "%s"; } 1498 1499 return (SETWINPOS, $timestamp, $conffile, $rule, $event); 1500 } 1501 1502 elsif ($action =~ /^(assign|assignsq)\s+(\S+)(?:\s+(.*\S))?$/i) { 1503 1504 $keyword = lc($1); 1505 $variable = $2; 1506 $value = defined($3)?$3:""; 1507 process_action_parens($value); 1508 1509 if ($variable !~ /^%[[:alpha:]]\w*$/) { 1510 log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 1511 "Variable $variable does not have the form", 1512 "%<letter>[<letter>|<digit>|<underscore>]..."); 1513 return INVALIDVALUE; 1514 } 1515 1516 if (!length($value)) { $value = "%s"; } 1517 1518 if ($keyword eq "assign") { 1519 return (ASSIGN, substr($variable, 1), $value); 1520 } else { return (ASSIGNSQ, substr($variable, 1), $value); } 1521 } 1522 1523 elsif ($action =~ /^free\s+(\S+)$/i) { 1524 1525 $variable = $1; 1526 1527 if ($variable !~ /^%[[:alpha:]]\w*$/) { 1528 log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 1529 "Variable $variable does not have the form", 1530 "%<letter>[<letter>|<digit>|<underscore>]..."); 1531 return INVALIDVALUE; 1532 } 1533 1534 return (FREE, substr($variable, 1)); 1535 } 1536 1537 elsif ($action =~ /^eval\s+(\S+)\s+(.*\S)$/i) { 1538 1539 $variable = $1; 1540 $code = $2; 1541 process_action_parens($code); 1542 1543 if ($variable !~ /^%[[:alpha:]]\w*$/) { 1544 log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 1545 "Variable $variable does not have the form", 1546 "%<letter>[<letter>|<digit>|<underscore>]..."); 1547 return INVALIDVALUE; 1548 } 1549 1550 return (EVAL, substr($variable, 1), $code); 1551 } 1552 1553 elsif ($action =~ /^call\s+(\S+)\s+(\S+)(?:\s+(.*\S))?$/i) { 1554 1555 $variable = $1; 1556 $codeptr = $2; 1557 $params = defined($3)?$3:""; 1558 1559 process_action_parens($params); 1560 1561 if ($variable !~ /^%[[:alpha:]]\w*$/) { 1562 log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 1563 "Variable $variable does not have the form", 1564 "%<letter>[<letter>|<digit>|<underscore>]..."); 1565 return INVALIDVALUE; 1566 } 1567 1568 if ($codeptr !~ /^%[[:alpha:]]\w*$/) { 1569 log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 1570 "Variable $codeptr does not have the form", 1571 "%<letter>[<letter>|<digit>|<underscore>]..."); 1572 return INVALIDVALUE; 1573 } 1574 1575 # note that if parameters are not provided, $params is set to 1576 # empty string, and in this case split() produces an empty list 1577 1578 return (CALL, substr($variable, 1), 1579 substr($codeptr, 1), [ split(' ', $params) ]); 1580 } 1581 1582 elsif ($action =~ /^lcall\s+(\S+)\s*(.*?)\s*(->|:>)\s*(.*\S)$/i) { 1583 1584 $variable = $1; 1585 $params = $2; 1586 $op = $3 eq ":>"; 1587 $code = $4; 1588 1589 process_action_parens($params, $code); 1590 1591 if ($variable !~ /^%[[:alpha:]]\w*$/) { 1592 log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 1593 "Variable $variable does not have the form", 1594 "%<letter>[<letter>|<digit>|<underscore>]..."); 1595 return INVALIDVALUE; 1596 } 1597 1598 ($evalok, $codeptr) = SEC::call_eval($code, 0); 1599 1600 if (!$evalok || !defined($codeptr) || ref($codeptr) ne "CODE") { 1601 log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 1602 "Eval '$code' didn't return a code reference:", 1603 defined($codeptr)?"$codeptr":"undef"); 1604 return INVALIDVALUE; 1605 } 1606 1607 # note that if parameters are not provided, $params is set to 1608 # empty string, and in this case split() produces an empty list 1609 1610 return (LCALL, substr($variable, 1), $codeptr, [ split(' ', $params) ], $op); 1611 } 1612 1613 elsif ($action =~ /^rewrite\s+(\S+)(?:\s+(.*\S))?$/i) { 1614 1615 $count = $1; 1616 $event = defined($2)?$2:""; 1617 process_action_parens($count, $event); 1618 1619 if (!length($count)) { 1620 log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 1621 "Empty linecount given for rewrite action"); 1622 return INVALIDVALUE; 1623 } 1624 1625 if (!length($event)) { $event = "%s"; } 1626 1627 return (REWRITE, $count, $event); 1628 } 1629 1630 elsif ($action =~ /^addinput\s+(\S+)(?:\s+(\S+)(?:\s+(\S+))?)?$/i) { 1631 1632 $file = $1; 1633 $fpos = defined($2)?$2:""; 1634 $context = defined($3)?$3:""; 1635 process_action_parens($file, $fpos, $context); 1636 1637 if (!length($file)) { 1638 log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 1639 "Empty filename given for addinput action"); 1640 return INVALIDVALUE; 1641 } 1642 1643 if (!length($fpos)) { $fpos = "-"; } 1644 if (!length($context)) { $context = FILEVENT_INT_CONTEXT_PREF . $file; } 1645 1646 return (ADDINPUT, $file, $fpos, $context); 1647 } 1648 1649 elsif ($action =~ /^sigemul\s+(\S+)$/i) { 1650 1651 $signal = $1; 1652 process_action_parens($signal); 1653 1654 if (!length($signal)) { 1655 log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 1656 "Empty signal name given for sigemul action"); 1657 return INVALIDVALUE; 1658 } 1659 1660 return (SIGEMUL, $signal); 1661 } 1662 1663 elsif ($action =~ /^varset\s+(\S+)\s+(\S+)$/i) { 1664 1665 $variable = $1; 1666 $entry = $2; 1667 process_action_parens($entry); 1668 1669 if ($variable !~ /^%[[:alpha:]]\w*$/) { 1670 log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 1671 "Variable $variable does not have the form", 1672 "%<letter>[<letter>|<digit>|<underscore>]..."); 1673 return INVALIDVALUE; 1674 } 1675 1676 if (!length($entry)) { 1677 log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 1678 "Empty pattern match cache entry name given for varset action"); 1679 return INVALIDVALUE; 1680 } 1681 1682 return (VARIABLESET, substr($variable, 1), $entry); 1683 } 1684 1685 elsif ($action =~ /^if\s/i) { 1686 1687 $value = EXPRSYMBOL; 1688 1689 if ($action2 =~ /^if\s+(\S+)\s+$value\s+else\s+$value$/i) { 1690 $variable = $1; 1691 $actionlist = $list->[0]; 1692 $actionlist2 = $list->[1]; 1693 } elsif ($action2 =~ /^if\s+(\S+)\s+$value$/i) { 1694 $variable = $1; 1695 $actionlist = $list->[0]; 1696 $actionlist2 = ""; 1697 } else { return INVALIDVALUE; } 1698 1699 if ($variable !~ /^%[[:alpha:]]\w*$/) { 1700 log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 1701 "Variable $variable does not have the form", 1702 "%<letter>[<letter>|<digit>|<underscore>]..."); 1703 return INVALIDVALUE; 1704 } 1705 1706 if ($actionlist =~ /^\s*$/) { @action = (); } 1707 elsif (!analyze_actionlist($actionlist, \@action, 1708 $conffile, $lineno, $ruleid)) { return INVALIDVALUE; } 1709 1710 if ($actionlist2 =~ /^\s*$/) { @action2 = (); } 1711 elsif (!analyze_actionlist($actionlist2, \@action2, 1712 $conffile, $lineno, $ruleid)) { return INVALIDVALUE; } 1713 1714 if (!scalar(@action) && !scalar(@action2)) { 1715 log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 1716 "empty action lists given for if-else"); 1717 return INVALIDVALUE; 1718 } 1719 1720 return (IF, substr($variable, 1), [ @action ], [ @action2 ]); 1721 } 1722 1723 elsif ($action =~ /^while\s/i) { 1724 1725 $value = EXPRSYMBOL; 1726 1727 if ($action2 =~ /^while\s+(\S+)\s+$value$/i) { 1728 $variable = $1; 1729 $actionlist = $list->[0]; 1730 } else { return INVALIDVALUE; } 1731 1732 if ($variable !~ /^%[[:alpha:]]\w*$/) { 1733 log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 1734 "Variable $variable does not have the form", 1735 "%<letter>[<letter>|<digit>|<underscore>]..."); 1736 return INVALIDVALUE; 1737 } 1738 1739 if ($actionlist =~ /^\s*$/) { 1740 log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 1741 "empty action list given for while"); 1742 return INVALIDVALUE; 1743 } 1744 1745 if (!analyze_actionlist($actionlist, \@action, 1746 $conffile, $lineno, $ruleid)) { return INVALIDVALUE; } 1747 1748 return (WHILE, substr($variable, 1), [ @action ]); 1749 } 1750 1751 elsif ($action =~ /^break$/i) { return BREAK; } 1752 1753 elsif ($action =~ /^continue$/i) { return CONTINUE; } 1754 1755 log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 1756 "Invalid action '$action'"); 1757 return INVALIDVALUE; 1758 1759} 1760 1761 1762# Parameters: par1 - action list separated by semicolons 1763# par2 - reference to an array 1764# par3 - the name of the configuration file 1765# par4 - line number in configuration file 1766# par5 - rule ID 1767# Action: par1 will be split to parts, each part is analyzed and saved 1768# to array @{$par2}. Previous content of the array is erased. 1769# Parameters par3..par5 will be passed to the analyze_action() 1770# function for logging purposes. Return 0 if an invalid action 1771# was detected in the list par1, otherwise return 1. 1772 1773sub analyze_actionlist { 1774 1775 my($actionlist, $arrayref, $conffile, $lineno, $ruleid) = @_; 1776 my(@parts, $part, $part2); 1777 my($actiontype, @action); 1778 my($newactionlist, @list, @list2, $expr); 1779 my($pos, $l); 1780 1781 @{$arrayref} = (); 1782 1783 # remove leading and trailing whitespace from actionlist 1784 if ($actionlist =~ /^\s*(.*?)\s*$/) { $actionlist = $1; } 1785 1786 # replace the actions that are in parentheses with special symbols 1787 # and save the actions to @list 1788 1789 $newactionlist = replace_subexpr($actionlist, \@list); 1790 1791 if (!defined($newactionlist)) { 1792 log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 1793 "Unbalanced parentheses found in action list '$actionlist'"); 1794 return 0; 1795 } 1796 1797 # split actionlist into parts by semicolon, removing 1798 # all whitespace before and after semicolons 1799 1800 @parts = split(/\s*;\s*/, $newactionlist); 1801 1802 $l = length(EXPRSYMBOL); 1803 1804 foreach $part (@parts) { 1805 1806 # substitute special symbols with expressions 1807 # that were removed previously 1808 1809 $part2 = $part; 1810 @list2 = (); 1811 1812 for (;;) { 1813 1814 $pos = index($part, EXPRSYMBOL); 1815 if ($pos == -1) { last; } 1816 1817 $expr = shift @list; 1818 substr($part, $pos, $l) = "(" . $expr . ")"; 1819 1820 push @list2, $expr; 1821 } 1822 1823 # analyze the action list part 1824 1825 ($actiontype, @action) = 1826 analyze_action($part, $conffile, $lineno, $ruleid, $part2, \@list2); 1827 1828 if ($actiontype == INVALIDVALUE) { return 0; } 1829 1830 push @{$arrayref}, $actiontype, @action; 1831 1832 } 1833 1834 return 1; 1835 1836} 1837 1838 1839# Parameters: par1 - context expression 1840# par2 - reference to an array 1841# Action: par1 will be analyzed and saved to array par2 (it is assumed 1842# that par1 does not contain expressions in parentheses). Previous 1843# content of the array par2 is erased. If errors are found when 1844# analyzing par1, 0 will be returned, otherwise 1 will be returned. 1845 1846sub analyze_context_expr { 1847 1848 my($context, $result) = @_; 1849 my($pos, $oper, $op1, $op2); 1850 my(@side1, @side2); 1851 my($evalok, $retval); 1852 1853 # if we are parsing '&&' and '||' operators that take 2 operands, 1854 # process the context expression from the end with rindex(), in order 1855 # to get "from left to right" processing for AND and OR at runtime 1856 1857 $pos = rindex($context, "||"); 1858 1859 if ($pos != -1) { 1860 1861 $op1 = substr($context, 0, $pos); 1862 $op2 = substr($context, $pos + 2); 1863 1864 if (!analyze_context_expr($op1, \@side1)) { return 0; } 1865 if (!analyze_context_expr($op2, \@side2)) { return 0; } 1866 1867 @{$result} = ( @side1, @side2, OR ); 1868 return 1; 1869 } 1870 1871 $pos = rindex($context, "&&"); 1872 1873 if ($pos != -1) { 1874 1875 $op1 = substr($context, 0, $pos); 1876 $op2 = substr($context, $pos + 2); 1877 1878 if (!analyze_context_expr($op1, \@side1)) { return 0; } 1879 if (!analyze_context_expr($op2, \@side2)) { return 0; } 1880 1881 @{$result} = ( @side1, @side2, AND ); 1882 return 1; 1883 } 1884 1885 # consider '!' operator a negation if it appears in front of the operand 1886 1887 if ($context =~ /^\s*!(.*)/) { 1888 1889 $op1 = $1; 1890 if (!analyze_context_expr($op1, \@side1)) { return 0; } 1891 1892 @{$result} = ( @side1, NEGATION ); 1893 return 1; 1894 } 1895 1896 # since CCODE, ECODE and OPERAND are terminals, make sure that any 1897 # leading and trailing whitespace is removed from their parameters 1898 # (rest of the code relies on that); also, remove backslashes in front 1899 # of the parentheses 1900 1901 if ($context =~ /^\s*(.*?)\s*(->|:>)\s*(.*\S)/) { 1902 1903 $op1 = $1; 1904 $oper = $2; 1905 $op2 = $3; 1906 1907 if ($op1 ne EXPRSYMBOL) { 1908 $op1 =~ s/\\([()])/$1/g; 1909 $op1 = [ split(' ', $op1) ]; 1910 } 1911 1912 if ($op2 ne EXPRSYMBOL) { 1913 1914 $op2 =~ s/\\([()])/$1/g; 1915 1916 ($evalok, $retval) = SEC::call_eval($op2, 0); 1917 1918 if (!$evalok || !defined($retval) || ref($retval) ne "CODE") { 1919 log_msg(LOG_ERR, "Eval '$op2' didn't return a code reference:", 1920 defined($retval)?"$retval":"undef"); 1921 return 0; 1922 } 1923 1924 $op2 = $retval; 1925 1926 } 1927 1928 if ($oper eq "->") { @{$result} = ( CCODE, $op1, $op2 ); } 1929 else { @{$result} = ( CCODE2, $op1, $op2 ); } 1930 1931 return 1; 1932 } 1933 1934 if ($context =~ /^\s*=\s*(.*\S)/) { 1935 1936 $op1 = $1; 1937 if ($op1 ne EXPRSYMBOL) { $op1 =~ s/\\([()])/$1/g; } 1938 1939 @{$result} = ( ECODE, $op1 ); 1940 return 1; 1941 } 1942 1943 if ($context =~ /^\s*varset\s+(\S+)\s*$/) { 1944 1945 $op1 = $1; 1946 if ($op1 ne EXPRSYMBOL) { $op1 =~ s/\\([()])/$1/g; } 1947 1948 @{$result} = ( VARSET, $op1 ); 1949 return 1; 1950 } 1951 1952 if ($context =~ /^\s*(\S+)\s*$/) { 1953 1954 $op1 = $1; 1955 if ($op1 ne EXPRSYMBOL) { $op1 =~ s/\\([()])/$1/g; } 1956 1957 @{$result} = ( OPERAND, $op1 ); 1958 return 1; 1959 } 1960 1961 return 0; 1962 1963} 1964 1965 1966# Parameters: par1 - context expression 1967# par2 - reference to an array 1968# Action: par1 will be analyzed and saved to array par2. Previous content 1969# of the array par2 is erased. If errors are found when analyzing 1970# par1, 0 will be returned, otherwise 1 will be returned. 1971 1972sub analyze_context { 1973 1974 my($context, $result) = @_; 1975 my($newcontext, $i, $j); 1976 my($params, $code, $evalok, $retval); 1977 my($subexpr, @expr); 1978 1979 # replace upper level expressions in parentheses with special symbol 1980 # and save the expressions to @expr (i.e. !(a && (b || c )) || d 1981 # becomes !specialsymbol || d, and "a && (b || c )" is saved to @expr); 1982 # if context was not parsed successfully, exit 1983 1984 $newcontext = replace_subexpr($context, \@expr); 1985 1986 if (!defined($newcontext)) { return 0; } 1987 1988 # convert context expression to internal format, and if no parenthesized 1989 # subexpressions were found in the expression during previous step, exit 1990 1991 if (!analyze_context_expr($newcontext, $result)) { return 0; } 1992 1993 if ($newcontext eq $context) { return 1; } 1994 1995 # If the expression contains parenthesized subexpressions, analyze and 1996 # convert these expressions recursively, attaching the results to 1997 # the current expression. If a parenthesized subexpression is a Perl code, 1998 # it will not be analyzed recursively but rather treated as a terminal 1999 # (backslashes in front of the parentheses are removed). If not all 2000 # subexpressions are consumed during the analysis, they have been defined 2001 # in invalid locations (e.g., inside context names). 2002 2003 $i = 0; 2004 $j = scalar(@{$result}); 2005 2006 while ($i < $j) { 2007 2008 if ($result->[$i] == OPERAND) { 2009 2010 if ($result->[$i+1] eq EXPRSYMBOL) { 2011 $result->[$i] = EXPRESSION; 2012 $result->[$i+1] = []; 2013 $subexpr = shift @expr; 2014 if (!analyze_context($subexpr, $result->[$i+1])) { return 0; } 2015 } 2016 2017 $i += 2; 2018 } 2019 2020 elsif ($result->[$i] == ECODE) { 2021 2022 if ($result->[$i+1] eq EXPRSYMBOL) { 2023 $code = shift @expr; 2024 $code =~ s/\\([()])/$1/g; 2025 $result->[$i+1] = $code; 2026 } 2027 2028 $i += 2; 2029 } 2030 2031 elsif ($result->[$i] == CCODE || $result->[$i] == CCODE2) { 2032 2033 if ($result->[$i+1] eq EXPRSYMBOL) { 2034 $params = shift @expr; 2035 $params =~ s/\\([()])/$1/g; 2036 $result->[$i+1] = [ split(' ', $params) ]; 2037 } 2038 2039 if ($result->[$i+2] eq EXPRSYMBOL) { 2040 2041 $code = shift @expr; 2042 $code =~ s/\\([()])/$1/g; 2043 2044 ($evalok, $retval) = SEC::call_eval($code, 0); 2045 2046 if (!$evalok || !defined($retval) || ref($retval) ne "CODE") { 2047 log_msg(LOG_ERR, "Eval '$code' didn't return a code reference:", 2048 defined($retval)?$retval:"undef"); 2049 return 0; 2050 } 2051 2052 $result->[$i+2] = $retval; 2053 2054 } 2055 2056 $i += 3; 2057 } 2058 2059 elsif ($result->[$i] == VARSET) { 2060 2061 if ($result->[$i+1] eq EXPRSYMBOL) { 2062 $subexpr = shift @expr; 2063 $subexpr =~ s/\\([()])/$1/g; 2064 $result->[$i+1] = $subexpr; 2065 } 2066 2067 $i += 2; 2068 } 2069 2070 else { ++$i; } 2071 2072 } 2073 2074 if (scalar(@expr)) { 2075 foreach $subexpr (@expr) { 2076 log_msg(LOG_ERR, "Unexpected subexpression '$subexpr' in '$context'"); 2077 } 2078 return 0; 2079 } 2080 2081 return 1; 2082 2083} 2084 2085 2086# Parameters: par1 - context expression 2087# Action: if par1 is surrounded by [] brackets, the brackets will be 2088# removed and 1 will be returned, otherwise 0 will be returned. 2089 2090sub check_context_preeval { 2091 2092 if ($_[0] =~ /^\s*\[(.*)\]\s*$/) { 2093 $_[0] = $1; 2094 return 1; 2095 } else { 2096 return 0; 2097 } 2098 2099} 2100 2101 2102# Parameters: par1 - list of the time values 2103# par2 - minimum possible value for time 2104# par3 - maximum possible value for time 2105# par4 - offset that must be added to every list value 2106# par5 - reference to a hash where every list value is added 2107# Action: take the list definition and find the time values that belong 2108# to the list (list definition is given in crontab-style). 2109# After the values have been calculated, add an element to par5 with 2110# the key that equals to the calculated value + offset. Leading zeros 2111# are removed from keys (rest of the code relies on that). E.g., if 2112# offset is 0, then "02,5-07" becomes 2,5,6,7; if offset is -1, min 2113# is 1, and max is 12, then "2,5-7,11-" becomes 1,4,5,6,10,11. Before 2114# adding elements to par5, its previous content is erased. If par1 is 2115# specified incorrectly, return value is 0, otherwise 1 is returned. 2116 2117sub eval_timelist { 2118 2119 my($spec, $min, $max, $offset, $ref) = @_; 2120 my(@parts, $part, $step); 2121 my($pos, $range1, $range2); 2122 my($i, $j); 2123 2124 # split time specification into parts (by comma) and look what 2125 # ranges or individual numbers every part defines 2126 2127 @parts = split(/,/, $spec); 2128 if (!scalar(@parts)) { return 0; } 2129 2130 %{$ref} = (); 2131 2132 foreach $part (@parts) { 2133 2134 # if part is empty, skip it and take the next part 2135 2136 if (!length($part)) { next; } 2137 2138 # check if part has a valid step value (0 is illegal) 2139 2140 if ($part =~ /^(.+)\/0*([0-9]+)$/) { 2141 $part = $1; 2142 $step = $2; 2143 if ($step == 0) { return 0; } 2144 } else { 2145 $step = undef; 2146 } 2147 2148 # if part equals to '*', assume that it defines the range min..max 2149 2150 if ($part eq "*") { 2151 2152 # add offset (this also forces numeric context, so "05" becomes "5") 2153 # and save values to the hash; if step was not defined, assume 1 2154 2155 $i = $min + $offset; 2156 $j = $max + $offset; 2157 2158 if (!defined($step)) { $step = 1; } 2159 2160 while ($i <= $j) { 2161 $ref->{$i} = 1; 2162 $i += $step; 2163 } 2164 2165 next; 2166 2167 } 2168 2169 # if part is not empty and not '*', check if it contains '-' 2170 2171 $pos = index($part, "-"); 2172 2173 if ($pos == -1) { 2174 2175 # if part does not contain '-', assume it defines a single number 2176 2177 if ($part =~ /^0*([0-9]+)$/) { $part = $1; } else { return 0; } 2178 if ($part < $min || $part > $max) { return 0; } 2179 2180 # step value is illegal for a single number 2181 2182 if (defined($step)) { return 0; } 2183 2184 # add offset and save value to the hash 2185 2186 $part += $offset; 2187 $ref->{$part} = 1; 2188 2189 } else { 2190 2191 # if part does contain '-', assume it defines a range 2192 2193 $range1 = substr($part, 0, $pos); 2194 $range2 = substr($part, $pos + 1); 2195 2196 # if left side of the range is missing, assume minimum for the value; 2197 # if right side of the range is missing, assume maximum for the value; 2198 # offset is then added to the left and right side of the range 2199 2200 if (length($range1)) { 2201 2202 if ($range1 =~ /^0*([0-9]+)$/) { $range1 = $1; } else { return 0; } 2203 if ($range1 < $min || $range1 > $max) { return 0; } 2204 2205 $i = $range1 + $offset; 2206 2207 } else { $i = $min + $offset; } 2208 2209 if (length($range2)) { 2210 2211 if ($range2 =~ /^0*([0-9]+)$/) { $range2 = $1; } else { return 0; } 2212 if ($range2 < $min || $range2 > $max) { return 0; } 2213 2214 $j = $range2 + $offset; 2215 2216 } else { $j = $max + $offset; } 2217 2218 # save values to the hash; if step was not defined, assume 1 2219 2220 if (!defined($step)) { $step = 1; } 2221 2222 while ($i <= $j) { 2223 $ref->{$i} = 1; 2224 $i += $step; 2225 } 2226 2227 } 2228 2229 } 2230 2231 return 1; 2232 2233} 2234 2235 2236# Parameters: par1 - time specification 2237# par2..par7 - references to the hashes of minutes, hours, 2238# days, months, weekdays and years 2239# par8 - the name of the configuration file 2240# par9 - line number in configuration file 2241# Action: par1 will be split to parts, every part is analyzed and 2242# results are saved into hashes par2..par6. 2243# Previous content of the hashes is erased. If errors 2244# are found when analyzing par1, 0 is returned, otherwise 1 2245# will be return value. 2246 2247sub analyze_timespec { 2248 2249 my($timespec, $minref, $hourref, $dayref, 2250 $monthref, $wdayref, $yearref, $conffile, $lineno) = @_; 2251 my(@parts, $size); 2252 2253 # split time specification into parts by whitespace (like with 2254 # split(/\s+/, ...)), but leading whitespace will be ignored 2255 2256 @parts = split(' ', $timespec); 2257 $size = scalar(@parts); 2258 2259 if ($size < 5 || $size > 6) { 2260 log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 2261 "Wrong number of elements in time specification"); 2262 return 0; 2263 } 2264 2265 # if no year specification has been given, assume * 2266 if ($size == 5) { push @parts, "*"; } 2267 2268 # evaluate minute specification (range 0..59, offset 0) 2269 2270 if (!eval_timelist($parts[0], 0, 59, 0, $minref)) { 2271 log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 2272 "Invalid minute specification '$parts[0]'"); 2273 return 0; 2274 } 2275 2276 # evaluate hour specification (range 0..23, offset 0) 2277 2278 if (!eval_timelist($parts[1], 0, 23, 0, $hourref)) { 2279 log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 2280 "Invalid hour specification '$parts[1]'"); 2281 return 0; 2282 } 2283 2284 # evaluate day specification (range 0..31, offset 0) 2285 # 0 denotes the last day of a month 2286 2287 if (!eval_timelist($parts[2], 0, 31, 0, $dayref)) { 2288 log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 2289 "Invalid day specification '$parts[2]'"); 2290 return 0; 2291 } 2292 2293 # evaluate month specification (range 1..12, offset -1) 2294 2295 if (!eval_timelist($parts[3], 1, 12, -1, $monthref)) { 2296 log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 2297 "Invalid month specification '$parts[3]'"); 2298 return 0; 2299 } 2300 2301 # evaluate weekday specification (range 0..7, offset 0) 2302 2303 if (!eval_timelist($parts[4], 0, 7, 0, $wdayref)) { 2304 log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 2305 "Invalid weekday specification '$parts[4]'"); 2306 return 0; 2307 } 2308 2309 # if 7 was specified as a weekday, also define 0, 2310 # since perl uses only 0 for Sunday 2311 2312 if (exists($wdayref->{"7"})) { $wdayref->{"0"} = 1; } 2313 2314 # evaluate year specification (range 0..99, offset 0) 2315 2316 if (!eval_timelist($parts[5], 0, 99, 0, $yearref)) { 2317 log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 2318 "Invalid year specification '$parts[5]'"); 2319 return 0; 2320 } 2321 2322 return 1; 2323 2324} 2325 2326 2327# Parameters: par1 - reference to a hash containing the rule 2328# par2 - hash of required and optional keywords for the rule 2329# par3 - the type of the rule 2330# par4 - the name of the configuration file 2331# par5 - line number in configuration file the rule begins at 2332# Action: check if all required keywords are present in the rule par1 and 2333# all keywords are legal (i.e., present in hash par2). 2334# Return 0 if keywords are OK, otherwise return 1. 2335 2336sub missing_keywords { 2337 2338 my($ref, $keyhash, $type, $conffile, $lineno) = @_; 2339 my($key, $error); 2340 2341 $error = 0; 2342 2343 # check if all required keywords are present in the rule 2344 2345 while ($key = each %{$keyhash}) { 2346 if ($keyhash->{$key} && !exists($ref->{$key})) { 2347 log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 2348 "Keyword '$key' missing (needed for $type rule)"); 2349 $error = 1; 2350 } 2351 } 2352 2353 # check if all rule keywords are legal 2354 2355 while ($key = each %{$ref}) { 2356 if (!exists($keyhash->{$key})) { 2357 log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 2358 "Keyword '$key' illegal (not allowed for $type rule)"); 2359 $error = 1; 2360 } 2361 } 2362 2363 return $error; 2364 2365} 2366 2367 2368# Parameters: par1 - reference to a hash containing the rule 2369# par2 - name of the configuration file 2370# par3 - line number in configuration file the rule begins at 2371# par4 - rule ID 2372# Action: check the rule par1 for correctness and save it to 2373# global array $configuration{par2} if it is well-defined; 2374# if the rule specified rule file options, save the options to 2375# global array $config_options{par2} if the rule is well-defined. 2376# For a correctly defined Options-rule return 2, for a correctly 2377# defined regular rule return 1, for an invalid rule return 0 2378 2379sub check_rule { 2380 2381 my($ref, $conffile, $lineno, $number) = @_; 2382 my($type, $rule, %keywords); 2383 my($ncomp, $cfset, $evtnum, $i, $j); 2384 2385 if (!exists($ref->{"type"})) { 2386 log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 2387 "Keyword 'type' missing"); 2388 return 0; 2389 } 2390 2391 $type = uc($ref->{"type"}); 2392 2393 # ------------------------------------------------------------ 2394 # SINGLE rule 2395 # ------------------------------------------------------------ 2396 2397 if ($type eq "SINGLE") { 2398 2399 %keywords = ("type" => 1, "continue" => 0, "ptype" => 1, "pattern" => 1, 2400 "varmap" => 0, "context" => 0, "desc" => 1, "action" => 1); 2401 2402 if (missing_keywords($ref, \%keywords, $type, 2403 $conffile, $lineno)) { return 0; } 2404 2405 $rule = { "ID" => $number, 2406 "Type" => SINGLE, 2407 "VarMap" => {}, 2408 "Context" => [], 2409 "Desc" => $ref->{"desc"}, 2410 "Action" => [], 2411 "MatchCount" => 0, 2412 "EventCount" => 0, 2413 "CPUtime" => 0, 2414 "LineNo" => $lineno }; 2415 2416 if (exists($ref->{"continue"})) { 2417 ($rule->{"WhatNext"}, $rule->{"GotoRule"}) = 2418 analyze_continue($ref->{"continue"}, $conffile, $lineno); 2419 if ($rule->{"WhatNext"} == INVALIDVALUE) { return 0; } 2420 } else { 2421 $rule->{"WhatNext"} = DONTCONT; 2422 $rule->{"GotoRule"} = undef; 2423 } 2424 2425 ($rule->{"PatType"}, $rule->{"PatLines"}, $rule->{"Pattern"}) = 2426 analyze_pattern($ref->{"ptype"}, $ref->{"pattern"}, $conffile, $lineno); 2427 if ($rule->{"PatType"} == INVALIDVALUE) { return 0; } 2428 2429 if (exists($ref->{"varmap"})) { 2430 if (!analyze_varmap($rule->{"PatType"}, $ref->{"varmap"}, 2431 $rule->{"VarMap"}, $conffile, $lineno)) { return 0; } 2432 } 2433 2434 if (exists($ref->{"context"})) { 2435 if (check_context_preeval($ref->{"context"})) 2436 { $rule->{"ContPreEval"} = 1; } 2437 if (!analyze_context($ref->{"context"}, $rule->{"Context"})) { 2438 log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 2439 "Invalid context expression '", $ref->{"context"}, "'"); 2440 return 0; 2441 } 2442 if (volatile_context($rule->{"Context"}, '$')) 2443 { $rule->{"ContVolat"} = 1; } 2444 } 2445 2446 if (!analyze_actionlist($ref->{"action"}, $rule->{"Action"}, 2447 $conffile, $lineno, $number)) { 2448 log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 2449 "Invalid action list '", $ref->{"action"}, "'"); 2450 return 0; 2451 } 2452 if (contains_matchvars($ref->{"action"}, '$')) 2453 { $rule->{"ActVolat"} = 1; } 2454 2455 $configuration{$conffile}->[$number] = $rule; 2456 2457 return 1; 2458 2459 } 2460 2461 # ------------------------------------------------------------ 2462 # SINGLE_W_SCRIPT rule 2463 # ------------------------------------------------------------ 2464 2465 elsif ($type eq "SINGLEWITHSCRIPT") { 2466 2467 %keywords = ("type" => 1, "continue" => 0, "ptype" => 1, "pattern" => 1, 2468 "varmap" => 0, "context" => 0, "script" => 1, "shell" => 0, 2469 "desc" => 1, "action" => 1, "action2" => 0); 2470 2471 if (missing_keywords($ref, \%keywords, $type, 2472 $conffile, $lineno)) { return 0; } 2473 2474 $rule = { "ID" => $number, 2475 "Type" => SINGLE_W_SCRIPT, 2476 "VarMap" => {}, 2477 "Context" => [], 2478 "Desc" => $ref->{"desc"}, 2479 "Action" => [], 2480 "Action2" => [], 2481 "MatchCount" => 0, 2482 "EventCount" => 0, 2483 "CPUtime" => 0, 2484 "LineNo" => $lineno }; 2485 2486 if (exists($ref->{"continue"})) { 2487 ($rule->{"WhatNext"}, $rule->{"GotoRule"}) = 2488 analyze_continue($ref->{"continue"}, $conffile, $lineno); 2489 if ($rule->{"WhatNext"} == INVALIDVALUE) { return 0; } 2490 } else { 2491 $rule->{"WhatNext"} = DONTCONT; 2492 $rule->{"GotoRule"} = undef; 2493 } 2494 2495 ($rule->{"PatType"}, $rule->{"PatLines"}, $rule->{"Pattern"}) = 2496 analyze_pattern($ref->{"ptype"}, $ref->{"pattern"}, $conffile, $lineno); 2497 if ($rule->{"PatType"} == INVALIDVALUE) { return 0; } 2498 2499 if (exists($ref->{"varmap"})) { 2500 if (!analyze_varmap($rule->{"PatType"}, $ref->{"varmap"}, 2501 $rule->{"VarMap"}, $conffile, $lineno)) { return 0; } 2502 } 2503 2504 if (exists($ref->{"context"})) { 2505 if (check_context_preeval($ref->{"context"})) 2506 { $rule->{"ContPreEval"} = 1; } 2507 if (!analyze_context($ref->{"context"}, $rule->{"Context"})) { 2508 log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 2509 "Invalid context expression '", $ref->{"context"}, "'"); 2510 return 0; 2511 } 2512 if (volatile_context($rule->{"Context"}, '$')) 2513 { $rule->{"ContVolat"} = 1; } 2514 } 2515 2516 if (exists($ref->{"shell"})) { 2517 if (uc($ref->{"shell"}) eq "YES") { 2518 $rule->{"Script"} = $ref->{"script"}; 2519 } elsif (uc($ref->{"shell"}) eq "NO") { 2520 $rule->{"Script"} = [ split(' ', $ref->{"script"}) ]; 2521 } else { 2522 log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 2523 "Invalid shell value '", $ref->{"shell"}, "'"); 2524 return 0; 2525 } 2526 } else { 2527 $rule->{"Script"} = $ref->{"script"}; 2528 } 2529 2530 if (!analyze_actionlist($ref->{"action"}, $rule->{"Action"}, 2531 $conffile, $lineno, $number)) { 2532 log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 2533 "Invalid action list '", $ref->{"action"}, "'"); 2534 return 0; 2535 } 2536 if (contains_matchvars($ref->{"action"}, '$')) 2537 { $rule->{"ActVolat"} = 1; } 2538 2539 if (exists($ref->{"action2"})) { 2540 if (!analyze_actionlist($ref->{"action2"}, $rule->{"Action2"}, 2541 $conffile, $lineno, $number)) { 2542 log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 2543 "Invalid action list '", $ref->{"action2"}, "'"); 2544 return 0; 2545 } 2546 if (contains_matchvars($ref->{"action2"}, '$')) 2547 { $rule->{"ActVolat2"} = 1; } 2548 } 2549 2550 $configuration{$conffile}->[$number] = $rule; 2551 2552 return 1; 2553 2554 } 2555 2556 # ------------------------------------------------------------ 2557 # SINGLE_W_SUPPRESS rule 2558 # ------------------------------------------------------------ 2559 2560 elsif ($type eq "SINGLEWITHSUPPRESS") { 2561 2562 %keywords = ("type" => 1, "continue" => 0, "ptype" => 1, "pattern" => 1, 2563 "varmap" => 0, "context" => 0, "desc" => 1, "action" => 1, 2564 "window" => 1); 2565 2566 if (missing_keywords($ref, \%keywords, $type, 2567 $conffile, $lineno)) { return 0; } 2568 2569 $rule = { "ID" => $number, 2570 "Type" => SINGLE_W_SUPPRESS, 2571 "VarMap" => {}, 2572 "Context" => [], 2573 "Desc" => $ref->{"desc"}, 2574 "Action" => [], 2575 "MatchCount" => 0, 2576 "EventCount" => 0, 2577 "CPUtime" => 0, 2578 "LineNo" => $lineno }; 2579 2580 if (exists($ref->{"continue"})) { 2581 ($rule->{"WhatNext"}, $rule->{"GotoRule"}) = 2582 analyze_continue($ref->{"continue"}, $conffile, $lineno); 2583 if ($rule->{"WhatNext"} == INVALIDVALUE) { return 0; } 2584 } else { 2585 $rule->{"WhatNext"} = DONTCONT; 2586 $rule->{"GotoRule"} = undef; 2587 } 2588 2589 ($rule->{"PatType"}, $rule->{"PatLines"}, $rule->{"Pattern"}) = 2590 analyze_pattern($ref->{"ptype"}, $ref->{"pattern"}, $conffile, $lineno); 2591 if ($rule->{"PatType"} == INVALIDVALUE) { return 0; } 2592 2593 if (exists($ref->{"varmap"})) { 2594 if (!analyze_varmap($rule->{"PatType"}, $ref->{"varmap"}, 2595 $rule->{"VarMap"}, $conffile, $lineno)) { return 0; } 2596 } 2597 2598 if (exists($ref->{"context"})) { 2599 if (check_context_preeval($ref->{"context"})) 2600 { $rule->{"ContPreEval"} = 1; } 2601 if (!analyze_context($ref->{"context"}, $rule->{"Context"})) { 2602 log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 2603 "Invalid context expression '", $ref->{"context"}, "'"); 2604 return 0; 2605 } 2606 if (volatile_context($rule->{"Context"}, '$')) 2607 { $rule->{"ContVolat"} = 1; } 2608 } 2609 2610 if (!analyze_actionlist($ref->{"action"}, $rule->{"Action"}, 2611 $conffile, $lineno, $number)) { 2612 log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 2613 "Invalid action list '", $ref->{"action"}, "'"); 2614 return 0; 2615 } 2616 if (contains_matchvars($ref->{"action"}, '$')) 2617 { $rule->{"ActVolat"} = 1; } 2618 2619 if ($ref->{"window"} !~ /^0*([0-9]+)$/ || $1 == 0) { 2620 log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 2621 "Invalid time window '", $ref->{"window"}, "'"); 2622 return 0; 2623 } else { $rule->{"Window"} = $1; } 2624 2625 $configuration{$conffile}->[$number] = $rule; 2626 2627 return 1; 2628 2629 } 2630 2631 # ------------------------------------------------------------ 2632 # PAIR rule 2633 # ------------------------------------------------------------ 2634 2635 elsif ($type eq "PAIR") { 2636 2637 %keywords = ("type" => 1, "continue" => 0, "ptype" => 1, "pattern" => 1, 2638 "varmap" => 0, "context" => 0, "desc" => 1, "action" => 1, 2639 "continue2" => 0, "ptype2" => 1, "pattern2" => 1, 2640 "varmap2" => 0, "context2" => 0, "desc2" => 1, 2641 "action2" => 1, "window" => 0); 2642 2643 if (missing_keywords($ref, \%keywords, $type, 2644 $conffile, $lineno)) { return 0; } 2645 2646 $rule = { "ID" => $number, 2647 "Type" => PAIR, 2648 "VarMap" => {}, 2649 "VarMap2" => {}, 2650 "Context" => [], 2651 "Context2" => [], 2652 "Desc" => $ref->{"desc"}, 2653 "Desc2" => $ref->{"desc2"}, 2654 "Action" => [], 2655 "Action2" => [], 2656 "Operations" => {}, 2657 "MatchCount" => 0, 2658 "EventCount" => 0, 2659 "CPUtime" => 0, 2660 "LineNo" => $lineno }; 2661 2662 if (exists($ref->{"continue"})) { 2663 ($rule->{"WhatNext"}, $rule->{"GotoRule"}) = 2664 analyze_continue($ref->{"continue"}, $conffile, $lineno); 2665 if ($rule->{"WhatNext"} == INVALIDVALUE) { return 0; } 2666 } else { 2667 $rule->{"WhatNext"} = DONTCONT; 2668 $rule->{"GotoRule"} = undef; 2669 } 2670 2671 if (exists($ref->{"continue2"})) { 2672 ($rule->{"WhatNext2"}, $rule->{"GotoRule2"}) = 2673 analyze_continue($ref->{"continue2"}, $conffile, $lineno); 2674 if ($rule->{"WhatNext2"} == INVALIDVALUE) { return 0; } 2675 } else { 2676 $rule->{"WhatNext2"} = DONTCONT; 2677 $rule->{"GotoRule2"} = undef; 2678 } 2679 2680 ($rule->{"PatType"}, $rule->{"PatLines"}, $rule->{"Pattern"}) = 2681 analyze_pattern($ref->{"ptype"}, $ref->{"pattern"}, $conffile, $lineno); 2682 if ($rule->{"PatType"} == INVALIDVALUE) { return 0; } 2683 2684 ($rule->{"PatType2"}, $rule->{"PatLines2"}, $rule->{"Pattern2"}, $ncomp) = 2685 analyze_pattern($ref->{"ptype2"}, $ref->{"pattern2"}, 2686 $conffile, $lineno, $rule->{"PatType"}); 2687 if ($rule->{"PatType2"} == INVALIDVALUE) { return 0; } 2688 if (defined($ncomp)) { $rule->{"Pat2NotCompiled"} = 1; } 2689 2690 if (exists($ref->{"varmap"})) { 2691 if (!analyze_varmap($rule->{"PatType"}, $ref->{"varmap"}, 2692 $rule->{"VarMap"}, $conffile, $lineno)) { return 0; } 2693 } 2694 2695 if (exists($ref->{"varmap2"})) { 2696 if (!analyze_varmap($rule->{"PatType2"}, $ref->{"varmap2"}, 2697 $rule->{"VarMap2"}, $conffile, $lineno)) { return 0; } 2698 } 2699 2700 if (exists($ref->{"context"})) { 2701 if (check_context_preeval($ref->{"context"})) 2702 { $rule->{"ContPreEval"} = 1; } 2703 if (!analyze_context($ref->{"context"}, $rule->{"Context"})) { 2704 log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 2705 "Invalid context expression '", $ref->{"context"}, "'"); 2706 return 0; 2707 } 2708 if (volatile_context($rule->{"Context"}, '$')) 2709 { $rule->{"ContVolat"} = 1; } 2710 } 2711 2712 if (exists($ref->{"context2"})) { 2713 if (check_context_preeval($ref->{"context2"})) 2714 { $rule->{"ContPreEval2"} = 1; } 2715 if (!analyze_context($ref->{"context2"}, $rule->{"Context2"})) { 2716 log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 2717 "Invalid context expression '", $ref->{"context2"}, "'"); 2718 return 0; 2719 } 2720 if (volatile_context($rule->{"Context2"}, '$', '%')) 2721 { $rule->{"ContVolat2"} = 1; } 2722 } 2723 2724 if (!analyze_actionlist($ref->{"action"}, $rule->{"Action"}, 2725 $conffile, $lineno, $number)) { 2726 log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 2727 "Invalid action list '", $ref->{"action"}, "'"); 2728 return 0; 2729 } 2730 if (contains_matchvars($ref->{"action"}, '$')) 2731 { $rule->{"ActVolat"} = 1; } 2732 2733 if (!analyze_actionlist($ref->{"action2"}, $rule->{"Action2"}, 2734 $conffile, $lineno, $number)) { 2735 log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 2736 "Invalid action list '", $ref->{"action2"}, "'"); 2737 return 0; 2738 } 2739 if (contains_matchvars($ref->{"action2"}, '$', '%')) 2740 { $rule->{"ActVolat2"} = 1; } 2741 2742 if (!exists($ref->{"window"})) { $rule->{"Window"} = 0; } 2743 elsif ($ref->{"window"} =~ /^0*([0-9]+)$/) { $rule->{"Window"} = $1; } 2744 else { 2745 log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 2746 "Invalid time window '", $ref->{"window"}, "'"); 2747 return 0; 2748 } 2749 2750 $configuration{$conffile}->[$number] = $rule; 2751 2752 return 1; 2753 2754 } 2755 2756 # ------------------------------------------------------------ 2757 # PAIR_W_WINDOW rule 2758 # ------------------------------------------------------------ 2759 2760 elsif ($type eq "PAIRWITHWINDOW") { 2761 2762 %keywords = ("type" => 1, "continue" => 0, "ptype" => 1, "pattern" => 1, 2763 "varmap" => 0, "context" => 0, "desc" => 1, "action" => 1, 2764 "continue2" => 0, "ptype2" => 1, "pattern2" => 1, 2765 "varmap2" => 0, "context2" => 0, "desc2" => 1, 2766 "action2" => 1, "window" => 1); 2767 2768 if (missing_keywords($ref, \%keywords, $type, 2769 $conffile, $lineno)) { return 0; } 2770 2771 $rule = { "ID" => $number, 2772 "Type" => PAIR_W_WINDOW, 2773 "VarMap" => {}, 2774 "VarMap2" => {}, 2775 "Context" => [], 2776 "Context2" => [], 2777 "Desc" => $ref->{"desc"}, 2778 "Desc2" => $ref->{"desc2"}, 2779 "Action" => [], 2780 "Action2" => [], 2781 "Operations" => {}, 2782 "MatchCount" => 0, 2783 "EventCount" => 0, 2784 "CPUtime" => 0, 2785 "LineNo" => $lineno }; 2786 2787 if (exists($ref->{"continue"})) { 2788 ($rule->{"WhatNext"}, $rule->{"GotoRule"}) = 2789 analyze_continue($ref->{"continue"}, $conffile, $lineno); 2790 if ($rule->{"WhatNext"} == INVALIDVALUE) { return 0; } 2791 } else { 2792 $rule->{"WhatNext"} = DONTCONT; 2793 $rule->{"GotoRule"} = undef; 2794 } 2795 2796 if (exists($ref->{"continue2"})) { 2797 ($rule->{"WhatNext2"}, $rule->{"GotoRule2"}) = 2798 analyze_continue($ref->{"continue2"}, $conffile, $lineno); 2799 if ($rule->{"WhatNext2"} == INVALIDVALUE) { return 0; } 2800 } else { 2801 $rule->{"WhatNext2"} = DONTCONT; 2802 $rule->{"GotoRule2"} = undef; 2803 } 2804 2805 ($rule->{"PatType"}, $rule->{"PatLines"}, $rule->{"Pattern"}) = 2806 analyze_pattern($ref->{"ptype"}, $ref->{"pattern"}, $conffile, $lineno); 2807 if ($rule->{"PatType"} == INVALIDVALUE) { return 0; } 2808 2809 ($rule->{"PatType2"}, $rule->{"PatLines2"}, $rule->{"Pattern2"}, $ncomp) = 2810 analyze_pattern($ref->{"ptype2"}, $ref->{"pattern2"}, 2811 $conffile, $lineno, $rule->{"PatType"}); 2812 if ($rule->{"PatType2"} == INVALIDVALUE) { return 0; } 2813 if (defined($ncomp)) { $rule->{"Pat2NotCompiled"} = 1; } 2814 2815 if (exists($ref->{"varmap"})) { 2816 if (!analyze_varmap($rule->{"PatType"}, $ref->{"varmap"}, 2817 $rule->{"VarMap"}, $conffile, $lineno)) { return 0; } 2818 } 2819 2820 if (exists($ref->{"varmap2"})) { 2821 if (!analyze_varmap($rule->{"PatType2"}, $ref->{"varmap2"}, 2822 $rule->{"VarMap2"}, $conffile, $lineno)) { return 0; } 2823 } 2824 2825 if (exists($ref->{"context"})) { 2826 if (check_context_preeval($ref->{"context"})) 2827 { $rule->{"ContPreEval"} = 1; } 2828 if (!analyze_context($ref->{"context"}, $rule->{"Context"})) { 2829 log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 2830 "Invalid context expression '", $ref->{"context"}, "'"); 2831 return 0; 2832 } 2833 if (volatile_context($rule->{"Context"}, '$')) 2834 { $rule->{"ContVolat"} = 1; } 2835 } 2836 2837 if (exists($ref->{"context2"})) { 2838 if (check_context_preeval($ref->{"context2"})) 2839 { $rule->{"ContPreEval2"} = 1; } 2840 if (!analyze_context($ref->{"context2"}, $rule->{"Context2"})) { 2841 log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 2842 "Invalid context expression '", $ref->{"context2"}, "'"); 2843 return 0; 2844 } 2845 if (volatile_context($rule->{"Context2"}, '$', '%')) 2846 { $rule->{"ContVolat2"} = 1; } 2847 } 2848 2849 if (!analyze_actionlist($ref->{"action"}, $rule->{"Action"}, 2850 $conffile, $lineno, $number)) { 2851 log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 2852 "Invalid action list '", $ref->{"action"}, "'"); 2853 return 0; 2854 } 2855 if (contains_matchvars($ref->{"action"}, '$')) 2856 { $rule->{"ActVolat"} = 1; } 2857 2858 if (!analyze_actionlist($ref->{"action2"}, $rule->{"Action2"}, 2859 $conffile, $lineno, $number)) { 2860 log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 2861 "Invalid action list '", $ref->{"action2"}, "'"); 2862 return 0; 2863 } 2864 if (contains_matchvars($ref->{"action2"}, '$', '%')) 2865 { $rule->{"ActVolat2"} = 1; } 2866 2867 if ($ref->{"window"} !~ /^0*([0-9]+)$/ || $1 == 0) { 2868 log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 2869 "Invalid time window '", $ref->{"window"}, "'"); 2870 return 0; 2871 } else { $rule->{"Window"} = $1; } 2872 2873 $configuration{$conffile}->[$number] = $rule; 2874 2875 return 1; 2876 2877 } 2878 2879 # ------------------------------------------------------------ 2880 # SINGLE_W_THRESHOLD rule 2881 # ------------------------------------------------------------ 2882 2883 elsif ($type eq "SINGLEWITHTHRESHOLD") { 2884 2885 %keywords = ("type" => 1, "continue" => 0, "ptype" => 1, "pattern" => 1, 2886 "varmap" => 0, "context" => 0, "desc" => 1, "action" => 1, 2887 "action2" => 0, "window" => 1, "thresh" => 1); 2888 2889 if (missing_keywords($ref, \%keywords, $type, 2890 $conffile, $lineno)) { return 0; } 2891 2892 $rule = { "ID" => $number, 2893 "Type" => SINGLE_W_THRESHOLD, 2894 "VarMap" => {}, 2895 "Context" => [], 2896 "Desc" => $ref->{"desc"}, 2897 "Action" => [], 2898 "Action2" => [], 2899 "MatchCount" => 0, 2900 "EventCount" => 0, 2901 "CPUtime" => 0, 2902 "LineNo" => $lineno }; 2903 2904 if (exists($ref->{"continue"})) { 2905 ($rule->{"WhatNext"}, $rule->{"GotoRule"}) = 2906 analyze_continue($ref->{"continue"}, $conffile, $lineno); 2907 if ($rule->{"WhatNext"} == INVALIDVALUE) { return 0; } 2908 } else { 2909 $rule->{"WhatNext"} = DONTCONT; 2910 $rule->{"GotoRule"} = undef; 2911 } 2912 2913 ($rule->{"PatType"}, $rule->{"PatLines"}, $rule->{"Pattern"}) = 2914 analyze_pattern($ref->{"ptype"}, $ref->{"pattern"}, $conffile, $lineno); 2915 if ($rule->{"PatType"} == INVALIDVALUE) { return 0; } 2916 2917 if (exists($ref->{"varmap"})) { 2918 if (!analyze_varmap($rule->{"PatType"}, $ref->{"varmap"}, 2919 $rule->{"VarMap"}, $conffile, $lineno)) { return 0; } 2920 } 2921 2922 if (exists($ref->{"context"})) { 2923 if (check_context_preeval($ref->{"context"})) 2924 { $rule->{"ContPreEval"} = 1; } 2925 if (!analyze_context($ref->{"context"}, $rule->{"Context"})) { 2926 log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 2927 "Invalid context expression '", $ref->{"context"}, "'"); 2928 return 0; 2929 } 2930 if (volatile_context($rule->{"Context"}, '$')) 2931 { $rule->{"ContVolat"} = 1; } 2932 } 2933 2934 if (!analyze_actionlist($ref->{"action"}, $rule->{"Action"}, 2935 $conffile, $lineno, $number)) { 2936 log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 2937 "Invalid action list '", $ref->{"action"}, "'"); 2938 return 0; 2939 } 2940 if (contains_matchvars($ref->{"action"}, '$')) 2941 { $rule->{"ActVolat"} = 1; } 2942 2943 if (exists($ref->{"action2"})) { 2944 if (!analyze_actionlist($ref->{"action2"}, $rule->{"Action2"}, 2945 $conffile, $lineno, $number)) { 2946 log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 2947 "Invalid action list '", $ref->{"action2"}, "'"); 2948 return 0; 2949 } 2950 if (contains_matchvars($ref->{"action2"}, '$')) 2951 { $rule->{"ActVolat2"} = 1; } 2952 } 2953 2954 if ($ref->{"window"} !~ /^0*([0-9]+)$/ || $1 == 0) { 2955 log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 2956 "Invalid time window '", $ref->{"window"}, "'"); 2957 return 0; 2958 } else { $rule->{"Window"} = $1; } 2959 2960 if ($ref->{"thresh"} !~ /^0*([0-9]+)$/ || $1 == 0) { 2961 log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 2962 "Invalid threshold '", $ref->{"thresh"}, "'"); 2963 return 0; 2964 } else { $rule->{"Threshold"} = $1; } 2965 2966 $configuration{$conffile}->[$number] = $rule; 2967 2968 return 1; 2969 2970 } 2971 2972 # ------------------------------------------------------------ 2973 # SINGLE_W_2_THRESHOLDS rule 2974 # ------------------------------------------------------------ 2975 2976 elsif ($type eq "SINGLEWITH2THRESHOLDS") { 2977 2978 %keywords = ("type" => 1, "continue" => 0, "ptype" => 1, "pattern" => 1, 2979 "varmap" => 0, "context" => 0, "desc" => 1, "action" => 1, 2980 "window" => 1, "thresh" => 1, "desc2" => 1, "action2" => 1, 2981 "window2" => 1, "thresh2" => 1); 2982 2983 if (missing_keywords($ref, \%keywords, $type, 2984 $conffile, $lineno)) { return 0; } 2985 2986 $rule = { "ID" => $number, 2987 "Type" => SINGLE_W_2_THRESHOLDS, 2988 "VarMap" => {}, 2989 "Context" => [], 2990 "Desc" => $ref->{"desc"}, 2991 "Desc2" => $ref->{"desc2"}, 2992 "Action" => [], 2993 "Action2" => [], 2994 "MatchCount" => 0, 2995 "EventCount" => 0, 2996 "CPUtime" => 0, 2997 "LineNo" => $lineno }; 2998 2999 if (exists($ref->{"continue"})) { 3000 ($rule->{"WhatNext"}, $rule->{"GotoRule"}) = 3001 analyze_continue($ref->{"continue"}, $conffile, $lineno); 3002 if ($rule->{"WhatNext"} == INVALIDVALUE) { return 0; } 3003 } else { 3004 $rule->{"WhatNext"} = DONTCONT; 3005 $rule->{"GotoRule"} = undef; 3006 } 3007 3008 ($rule->{"PatType"}, $rule->{"PatLines"}, $rule->{"Pattern"}) = 3009 analyze_pattern($ref->{"ptype"}, $ref->{"pattern"}, $conffile, $lineno); 3010 if ($rule->{"PatType"} == INVALIDVALUE) { return 0; } 3011 3012 if (exists($ref->{"varmap"})) { 3013 if (!analyze_varmap($rule->{"PatType"}, $ref->{"varmap"}, 3014 $rule->{"VarMap"}, $conffile, $lineno)) { return 0; } 3015 } 3016 3017 if (exists($ref->{"context"})) { 3018 if (check_context_preeval($ref->{"context"})) 3019 { $rule->{"ContPreEval"} = 1; } 3020 if (!analyze_context($ref->{"context"}, $rule->{"Context"})) { 3021 log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 3022 "Invalid context expression '", $ref->{"context"}, "'"); 3023 return 0; 3024 } 3025 if (volatile_context($rule->{"Context"}, '$')) 3026 { $rule->{"ContVolat"} = 1; } 3027 } 3028 3029 if (!analyze_actionlist($ref->{"action"}, $rule->{"Action"}, 3030 $conffile, $lineno, $number)) { 3031 log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 3032 "Invalid action list '", $ref->{"action"}, "'"); 3033 return 0; 3034 } 3035 if (contains_matchvars($ref->{"action"}, '$')) 3036 { $rule->{"ActVolat"} = 1; } 3037 3038 if (!analyze_actionlist($ref->{"action2"}, $rule->{"Action2"}, 3039 $conffile, $lineno, $number)) { 3040 log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 3041 "Invalid action list '", $ref->{"action2"}, "'"); 3042 return 0; 3043 } 3044 if (contains_matchvars($ref->{"action2"}, '$')) 3045 { $rule->{"ActVolat2"} = 1; } 3046 3047 if ($ref->{"window"} !~ /^0*([0-9]+)$/ || $1 == 0) { 3048 log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 3049 "Invalid 1st time window '", $ref->{"window"}, "'"); 3050 return 0; 3051 } else { $rule->{"Window"} = $1; } 3052 3053 if ($ref->{"window2"} !~ /^0*([0-9]+)$/ || $1 == 0) { 3054 log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 3055 "Invalid 2nd time window '", $ref->{"window2"}, "'"); 3056 return 0; 3057 } else { $rule->{"Window2"} = $1; } 3058 3059 if ($ref->{"thresh"} !~ /^0*([0-9]+)$/ || $1 == 0) { 3060 log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 3061 "Invalid 1st threshold '", $ref->{"thresh"}, "'"); 3062 return 0; 3063 } else { $rule->{"Threshold"} = $1; } 3064 3065 if ($ref->{"thresh2"} !~ /^0*([0-9]+)$/) { 3066 log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 3067 "Invalid 2nd threshold '", $ref->{"thresh2"}, "'"); 3068 return 0; 3069 } else { $rule->{"Threshold2"} = $1; } 3070 3071 $configuration{$conffile}->[$number] = $rule; 3072 3073 return 1; 3074 3075 } 3076 3077 # ------------------------------------------------------------ 3078 # EVENT_GROUP rule 3079 # ------------------------------------------------------------ 3080 3081 elsif ($type =~ /^EVENTGROUP(?:0*\B)?([0-9]*)$/) { 3082 3083 $evtnum = length($1)?$1:1; 3084 3085 if ($evtnum < 1) { 3086 log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 3087 "Invalid rule type $type (N must be at least 1 for EventGroupN rule)"); 3088 return 0; 3089 } 3090 3091 %keywords = ("type" => 1, "desc" => 1, "action" => 1, "multact" => 0, 3092 "init" => 0, "slide" => 0, "end" => 0, "window" => 1, 3093 "egptype" => 0, "egpattern" => 0); 3094 3095 for ($i = 0; $i < $evtnum; ++$i) { 3096 $j = ($i==0)?"":($i+1); 3097 $keywords{"continue$j"} = 0; 3098 $keywords{"ptype$j"} = 1; 3099 $keywords{"pattern$j"} = 1; 3100 $keywords{"varmap$j"} = 0; 3101 $keywords{"context$j"} = 0; 3102 $keywords{"count$j"} = 0; 3103 $keywords{"thresh$j"} = 0; 3104 } 3105 3106 if (missing_keywords($ref, \%keywords, $type, 3107 $conffile, $lineno)) { return 0; } 3108 3109 $rule = { "ID" => $number, 3110 "Type" => EVENT_GROUP, 3111 "EventNumber" => $evtnum, 3112 "WhatNextList" => [], 3113 "GotoRuleList" => [], 3114 "PatTypeList" => [], 3115 "PatternList" => [], 3116 "PatLinesList" => [], 3117 "VarMapList" => [], 3118 "ContextList" => [], 3119 "ContPreEvalList" => {}, 3120 "ContVolatList" => {}, 3121 "CountActionList" => [], 3122 "CountActVolatList" => {}, 3123 "ThresholdList" => [], 3124 "Desc" => $ref->{"desc"}, 3125 "Action" => [], 3126 "InitAction" => [], 3127 "SlideAction" => [], 3128 "EndAction" => [], 3129 "MatchCount" => 0, 3130 "EventCount" => 0, 3131 "CPUtime" => 0, 3132 "LineNo" => $lineno }; 3133 3134 for ($i = 0; $i < $evtnum; ++$i) { 3135 3136 $rule->{"VarMapList"}->[$i] = {}; 3137 $rule->{"ContextList"}->[$i] = []; 3138 $rule->{"CountActionList"}->[$i] = []; 3139 3140 $j = ($i==0)?"":($i+1); 3141 3142 if (exists($ref->{"continue$j"})) { 3143 ($rule->{"WhatNextList"}->[$i], $rule->{"GotoRuleList"}->[$i]) = 3144 analyze_continue($ref->{"continue$j"}, $conffile, $lineno); 3145 if ($rule->{"WhatNextList"}->[$i] == INVALIDVALUE) { return 0; } 3146 } else { 3147 $rule->{"WhatNextList"}->[$i] = DONTCONT; 3148 $rule->{"GotoRuleList"}->[$i] = undef; 3149 } 3150 3151 ($rule->{"PatTypeList"}->[$i], 3152 $rule->{"PatLinesList"}->[$i], 3153 $rule->{"PatternList"}->[$i]) = analyze_pattern($ref->{"ptype$j"}, 3154 $ref->{"pattern$j"}, 3155 $conffile, $lineno); 3156 if ($rule->{"PatTypeList"}->[$i] == INVALIDVALUE) { return 0; } 3157 3158 if (exists($ref->{"varmap$j"})) { 3159 if (!analyze_varmap($rule->{"PatTypeList"}->[$i], 3160 $ref->{"varmap$j"}, $rule->{"VarMapList"}->[$i], 3161 $conffile, $lineno)) { return 0; } 3162 } 3163 3164 if (exists($ref->{"context$j"})) { 3165 if (check_context_preeval($ref->{"context$j"})) 3166 { $rule->{"ContPreEvalList"}->{$i} = 1; } 3167 if (!analyze_context($ref->{"context$j"}, 3168 $rule->{"ContextList"}->[$i])) { 3169 log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 3170 "Invalid context expression '", $ref->{"context$j"}, "'"); 3171 return 0; 3172 } 3173 if (volatile_context($rule->{"ContextList"}->[$i], '$')) 3174 { $rule->{"ContVolatList"}->{$i} = 1; } 3175 } 3176 3177 if (exists($ref->{"count$j"})) { 3178 if (!analyze_actionlist($ref->{"count$j"}, 3179 $rule->{"CountActionList"}->[$i], 3180 $conffile, $lineno, $number)) { 3181 log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 3182 "Invalid action list '", $ref->{"count$j"}, "'"); 3183 return 0; 3184 } 3185 if (contains_matchvars($ref->{"count$j"}, '$')) 3186 { $rule->{"CountActVolatList"}->{$i} = 1; } 3187 } 3188 3189 if (exists($ref->{"thresh$j"})) { 3190 if ($ref->{"thresh$j"} !~ /^0*([0-9]+)$/ || $1 == 0) { 3191 log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 3192 "Invalid threshold '", $ref->{"thresh$j"}, "'"); 3193 return 0; 3194 } else { $rule->{"ThresholdList"}->[$i] = $1; } 3195 } else { $rule->{"ThresholdList"}->[$i] = 1; } 3196 3197 } 3198 3199 if (!analyze_actionlist($ref->{"action"}, $rule->{"Action"}, 3200 $conffile, $lineno, $number)) { 3201 log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 3202 "Invalid action list '", $ref->{"action"}, "'"); 3203 return 0; 3204 } 3205 if (contains_matchvars($ref->{"action"}, '$')) 3206 { $rule->{"ActVolat"} = 1; } 3207 3208 if (exists($ref->{"init"})) { 3209 if (!analyze_actionlist($ref->{"init"}, $rule->{"InitAction"}, 3210 $conffile, $lineno, $number)) { 3211 log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 3212 "Invalid action list '", $ref->{"init"}, "'"); 3213 return 0; 3214 } 3215 if (contains_matchvars($ref->{"init"}, '$')) 3216 { $rule->{"InitActVolat"} = 1; } 3217 } 3218 3219 if (exists($ref->{"slide"})) { 3220 if (!analyze_actionlist($ref->{"slide"}, $rule->{"SlideAction"}, 3221 $conffile, $lineno, $number)) { 3222 log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 3223 "Invalid action list '", $ref->{"slide"}, "'"); 3224 return 0; 3225 } 3226 if (contains_matchvars($ref->{"slide"}, '$')) 3227 { $rule->{"SlideActVolat"} = 1; } 3228 } 3229 3230 if (exists($ref->{"end"})) { 3231 if (!analyze_actionlist($ref->{"end"}, $rule->{"EndAction"}, 3232 $conffile, $lineno, $number)) { 3233 log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 3234 "Invalid action list '", $ref->{"end"}, "'"); 3235 return 0; 3236 } 3237 if (contains_matchvars($ref->{"end"}, '$')) 3238 { $rule->{"EndActVolat"} = 1; } 3239 } 3240 3241 if ($ref->{"window"} !~ /^0*([0-9]+)$/ || $1 == 0) { 3242 log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 3243 "Invalid time window '", $ref->{"window"}, "'"); 3244 return 0; 3245 } else { $rule->{"Window"} = $1; } 3246 3247 if (exists($ref->{"multact"})) { 3248 if (uc($ref->{"multact"}) eq "YES") { $rule->{"MultipleActions"} = 1; } 3249 elsif (uc($ref->{"multact"}) ne "NO") { 3250 log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 3251 "Invalid multact value '", $ref->{"multact"}, "'"); 3252 return 0; 3253 } 3254 } 3255 3256 if (exists($ref->{"egptype"}) && !exists($ref->{"egpattern"}) || 3257 !exists($ref->{"egptype"}) && exists($ref->{"egpattern"})) { 3258 log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 3259 "Keywords 'egptype' and 'egpattern' must be used together"); 3260 return 0; 3261 } 3262 3263 if (exists($ref->{"egptype"}) && exists($ref->{"egpattern"})) { 3264 ($rule->{"EGrpPatType"}, $rule->{"EGrpPattern"}) = 3265 analyze_eventgroup_pattern($ref->{"egptype"}, $ref->{"egpattern"}, 3266 $conffile, $lineno); 3267 if ($rule->{"EGrpPatType"} == INVALIDVALUE) { return 0; } 3268 } 3269 3270 $configuration{$conffile}->[$number] = $rule; 3271 3272 return 1; 3273 3274 } 3275 3276 # ------------------------------------------------------------ 3277 # SUPPRESS rule 3278 # ------------------------------------------------------------ 3279 3280 elsif ($type eq "SUPPRESS") { 3281 3282 %keywords = ("type" => 1, "ptype" => 1, "pattern" => 1, 3283 "varmap" => 0, "context" => 0, "desc" => 0); 3284 3285 if (missing_keywords($ref, \%keywords, $type, 3286 $conffile, $lineno)) { return 0; } 3287 3288 $rule = { "ID" => $number, 3289 "Type" => SUPPRESS, 3290 "VarMap" => {}, 3291 "Context" => [], 3292 "MatchCount" => 0, 3293 "EventCount" => 0, 3294 "CPUtime" => 0, 3295 "LineNo" => $lineno }; 3296 3297 ($rule->{"PatType"}, $rule->{"PatLines"}, $rule->{"Pattern"}) = 3298 analyze_pattern($ref->{"ptype"}, $ref->{"pattern"}, $conffile, $lineno); 3299 if ($rule->{"PatType"} == INVALIDVALUE) { return 0; } 3300 3301 if (exists($ref->{"varmap"})) { 3302 if (!analyze_varmap($rule->{"PatType"}, $ref->{"varmap"}, 3303 $rule->{"VarMap"}, $conffile, $lineno)) { return 0; } 3304 } 3305 3306 if (exists($ref->{"context"})) { 3307 if (check_context_preeval($ref->{"context"})) 3308 { $rule->{"ContPreEval"} = 1; } 3309 if (!analyze_context($ref->{"context"}, $rule->{"Context"})) { 3310 log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 3311 "Invalid context expression '", $ref->{"context"}, "'"); 3312 return 0; 3313 } 3314 if (volatile_context($rule->{"Context"}, '$')) 3315 { $rule->{"ContVolat"} = 1; } 3316 } 3317 3318 if (!exists($ref->{"desc"})) { 3319 if ($rule->{"PatType"} == REGEXP || $rule->{"PatType"} == SUBSTR || 3320 $rule->{"PatType"} == PERLFUNC || $rule->{"PatType"} == CACHED) { 3321 $rule->{"Desc"} = 3322 "Suppress rule with pattern: " . $rule->{"Pattern"}; 3323 } elsif ($rule->{"PatType"} == NREGEXP || 3324 $rule->{"PatType"} == NSUBSTR || 3325 $rule->{"PatType"} == NPERLFUNC || 3326 $rule->{"PatType"} == NCACHED) { 3327 $rule->{"Desc"} = 3328 "Suppress rule with negative pattern: " . $rule->{"Pattern"}; 3329 } else { 3330 $rule->{"Desc"} = 3331 "Suppress rule with pattern: " . ($rule->{"Pattern"}?"TRUE":"FALSE"); 3332 } 3333 } else { $rule->{"Desc"} = $ref->{"desc"}; } 3334 3335 $configuration{$conffile}->[$number] = $rule; 3336 3337 return 1; 3338 3339 } 3340 3341 # ------------------------------------------------------------ 3342 # CALENDAR rule 3343 # ------------------------------------------------------------ 3344 3345 elsif ($type eq "CALENDAR") { 3346 3347 %keywords = ("type" => 1, "time" => 1, "context" => 0, 3348 "desc" => 1, "action" => 1); 3349 3350 if (missing_keywords($ref, \%keywords, $type, 3351 $conffile, $lineno)) { return 0; } 3352 3353 $rule = { "ID" => $number, 3354 "Type" => CALENDAR, 3355 "Minutes" => {}, 3356 "Hours" => {}, 3357 "Days" => {}, 3358 "Months" => {}, 3359 "Weekdays" => {}, 3360 "Years" => {}, 3361 "LastActionMinute" => 0, 3362 "LastActionHour" => 0, 3363 "LastActionDay" => 0, 3364 "LastActionMonth" => 0, 3365 "LastActionYear" => 0, 3366 "Context" => [], 3367 "Desc" => $ref->{"desc"}, 3368 "Action" => [], 3369 "MatchCount" => 0, 3370 "EventCount" => 0, 3371 "CPUtime" => 0, 3372 "LineNo" => $lineno }; 3373 3374 if (!analyze_timespec($ref->{"time"}, 3375 $rule->{"Minutes"}, $rule->{"Hours"}, 3376 $rule->{"Days"}, $rule->{"Months"}, 3377 $rule->{"Weekdays"}, $rule->{"Years"}, 3378 $conffile, $lineno)) { return 0; } 3379 3380 # since for Calendar rule []-operator has no meaning, remove outer 3381 # square brackets if they exist, and don't set the ContPreEval flag 3382 3383 if (exists($ref->{"context"})) { 3384 check_context_preeval($ref->{"context"}); 3385 if (!analyze_context($ref->{"context"}, $rule->{"Context"})) { 3386 log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 3387 "Invalid context expression '", $ref->{"context"}, "'"); 3388 return 0; 3389 } 3390 } 3391 3392 if (!analyze_actionlist($ref->{"action"}, $rule->{"Action"}, 3393 $conffile, $lineno, $number)) { 3394 log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 3395 "Invalid action list '", $ref->{"action"}, "'"); 3396 return 0; 3397 } 3398 3399 $configuration{$conffile}->[$number] = $rule; 3400 3401 return 1; 3402 3403 } 3404 3405 # ------------------------------------------------------------ 3406 # JUMP rule 3407 # ------------------------------------------------------------ 3408 3409 elsif ($type eq "JUMP") { 3410 3411 %keywords = ("type" => 1, "continue" => 0, "ptype" => 1, 3412 "pattern" => 1, "varmap" => 0, "context" => 0, 3413 "cfset" => 0, "constset" => 0, "desc" => 0); 3414 3415 if (missing_keywords($ref, \%keywords, $type, 3416 $conffile, $lineno)) { return 0; } 3417 3418 $rule = { "ID" => $number, 3419 "Type" => JUMP, 3420 "VarMap" => {}, 3421 "Context" => [], 3422 "MatchCount" => 0, 3423 "EventCount" => 0, 3424 "CPUtime" => 0, 3425 "LineNo" => $lineno }; 3426 3427 if (exists($ref->{"continue"})) { 3428 ($rule->{"WhatNext"}, $rule->{"GotoRule"}) = 3429 analyze_continue($ref->{"continue"}, $conffile, $lineno); 3430 if ($rule->{"WhatNext"} == INVALIDVALUE) { return 0; } 3431 } else { 3432 $rule->{"WhatNext"} = DONTCONT; 3433 $rule->{"GotoRule"} = undef; 3434 } 3435 3436 ($rule->{"PatType"}, $rule->{"PatLines"}, $rule->{"Pattern"}) = 3437 analyze_pattern($ref->{"ptype"}, $ref->{"pattern"}, $conffile, $lineno); 3438 if ($rule->{"PatType"} == INVALIDVALUE) { return 0; } 3439 3440 if (exists($ref->{"varmap"})) { 3441 if (!analyze_varmap($rule->{"PatType"}, $ref->{"varmap"}, 3442 $rule->{"VarMap"}, $conffile, $lineno)) { return 0; } 3443 } 3444 3445 if (exists($ref->{"context"})) { 3446 if (check_context_preeval($ref->{"context"})) 3447 { $rule->{"ContPreEval"} = 1; } 3448 if (!analyze_context($ref->{"context"}, $rule->{"Context"})) { 3449 log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 3450 "Invalid context expression '", $ref->{"context"}, "'"); 3451 return 0; 3452 } 3453 if (volatile_context($rule->{"Context"}, '$')) 3454 { $rule->{"ContVolat"} = 1; } 3455 } 3456 3457 if (!exists($ref->{"desc"})) { 3458 if ($rule->{"PatType"} == REGEXP || $rule->{"PatType"} == SUBSTR || 3459 $rule->{"PatType"} == PERLFUNC || $rule->{"PatType"} == CACHED) { 3460 $rule->{"Desc"} = 3461 "Jump rule with pattern: " . $rule->{"Pattern"}; 3462 } elsif ($rule->{"PatType"} == NREGEXP || 3463 $rule->{"PatType"} == NSUBSTR || 3464 $rule->{"PatType"} == NPERLFUNC || 3465 $rule->{"PatType"} == NCACHED) { 3466 $rule->{"Desc"} = 3467 "Jump rule with negative pattern: " . $rule->{"Pattern"}; 3468 } else { 3469 $rule->{"Desc"} = 3470 "Jump rule with pattern: " . ($rule->{"Pattern"}?"TRUE":"FALSE"); 3471 } 3472 } else { $rule->{"Desc"} = $ref->{"desc"}; } 3473 3474 if (exists($ref->{"cfset"})) { 3475 $rule->{"CFSet"} = [ split(' ', $ref->{"cfset"}) ]; 3476 } 3477 3478 if (exists($ref->{"constset"})) { 3479 if (uc($ref->{"constset"}) eq "YES") { $rule->{"ConstSet"} = 1; } 3480 elsif (uc($ref->{"constset"}) ne "NO") { 3481 log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 3482 "Invalid constset value '", $ref->{"constset"}, "'"); 3483 return 0; 3484 } 3485 } else { $rule->{"ConstSet"} = 1; } 3486 3487 $configuration{$conffile}->[$number] = $rule; 3488 3489 return 1; 3490 3491 } 3492 3493 # ------------------------------------------------------------ 3494 # OPTIONS rule 3495 # ------------------------------------------------------------ 3496 3497 elsif ($type eq "OPTIONS") { 3498 3499 %keywords = ("type" => 1, "joincfset" => 0, "procallin" => 0); 3500 3501 if (missing_keywords($ref, \%keywords, $type, 3502 $conffile, $lineno)) { return 0; } 3503 3504 # discard any previous Options rule 3505 3506 $config_options{$conffile} = {}; 3507 3508 # parse and save the procallin value; assume default for invalid value 3509 3510 if (exists($ref->{"procallin"})) { 3511 if (uc($ref->{"procallin"}) eq "NO") { 3512 $config_options{$conffile}->{"JumpOnly"} = 1; 3513 } elsif (uc($ref->{"procallin"}) ne "YES") { 3514 log_msg(LOG_WARN, "Rule in $conffile at line $lineno:", 3515 "Invalid procallin value '", $ref->{"procallin"}, 3516 "', assuming procallin=Yes"); 3517 } 3518 } 3519 3520 # parse and save the list of set names 3521 3522 if (exists($ref->{"joincfset"})) { 3523 $config_options{$conffile}->{"CFSet"} = {}; 3524 foreach $cfset (split(' ', $ref->{"joincfset"})) { 3525 $config_options{$conffile}->{"CFSet"}->{$cfset} = 1; 3526 } 3527 } 3528 3529 return 2; 3530 3531 } 3532 3533 # ------------------------------------------------------------ 3534 # end of rule processing 3535 # ------------------------------------------------------------ 3536 3537 log_msg(LOG_ERR, "Rule in $conffile at line $lineno:", 3538 "Invalid rule type $type"); 3539 return 0; 3540 3541} 3542 3543 3544# Parameters: par1 - name of the configuration file 3545# par2 - reference to the hash of label->rule conversion 3546# Action: process continue-statements of rules of configuration file par1, 3547# and resolve labels in 'continue=GoTo <label>' directives to rule 3548# numbers. The numbers are stored into memory-based representation 3549# of rules. Note that 'continue=TakeNext' is treated as 3550# 'continue=GoTo <nextrule>' (i.e., the number of the next rule is 3551# stored). Also note that 'continue=DontCont' is treated as 3552# 'continue=GoTo <lastrule+1>', and 'continue=EndMatch' as 3553# 'continue=GoTo -1'. Although Suppress rule doesn't support 3554# continue-statement, internally 'continue=GoTo <lastrule+1>' is used 3555# for simplifying the rule processing at run time. 3556 3557sub resolve_labels { 3558 3559 my($conffile, $label2rule) = @_; 3560 my($i, $j, $k, $n); 3561 my($ref, $label, $id, $lineno); 3562 3563 $n = scalar(@{$configuration{$conffile}}); 3564 3565 for ($i = 0; $i < $n; ++$i) { 3566 3567 $ref = $configuration{$conffile}->[$i]; 3568 3569 if ($ref->{"Type"} == SUPPRESS) { $ref->{"GotoRule"} = $n; } 3570 3571 elsif (exists($ref->{"WhatNextList"})) { 3572 3573 for ($j = 0; $j < $ref->{"EventNumber"}; ++$j) { 3574 3575 if ($ref->{"WhatNextList"}->[$j] == GOTO) { 3576 3577 $label = $ref->{"GotoRuleList"}->[$j]; 3578 $lineno = $ref->{"LineNo"}; 3579 $k = ($j==0)?"":($j+1); 3580 3581 if (exists($label2rule->{$label})) { 3582 3583 $id = $label2rule->{$label}; 3584 if ($id <= $i) { 3585 log_msg(LOG_WARN, "Rule in $conffile at line $lineno:", 3586 "can't go backwards to label $label, assuming continue$k=DontCont"); 3587 $ref->{"WhatNextList"}->[$j] = DONTCONT; 3588 $ref->{"GotoRuleList"}->[$j] = $n; 3589 } else { $ref->{"GotoRuleList"}->[$j] = $id; } 3590 3591 } else { 3592 log_msg(LOG_WARN, "Rule in $conffile at line $lineno:", 3593 "label $label does not exist, assuming continue$k=DontCont"); 3594 $ref->{"WhatNextList"}->[$j] = DONTCONT; 3595 $ref->{"GotoRuleList"}->[$j] = $n; 3596 } 3597 3598 } elsif ($ref->{"WhatNextList"}->[$j] == TAKENEXT) { 3599 $ref->{"GotoRuleList"}->[$j] = $i + 1; 3600 } elsif ($ref->{"WhatNextList"}->[$j] == DONTCONT) { 3601 $ref->{"GotoRuleList"}->[$j] = $n; 3602 } elsif ($ref->{"WhatNextList"}->[$j] == ENDMATCH) { 3603 $ref->{"GotoRuleList"}->[$j] = -1; 3604 } 3605 3606 } 3607 } 3608 3609 else { 3610 3611 if (exists($ref->{"WhatNext"})) { 3612 3613 if ($ref->{"WhatNext"} == GOTO) { 3614 3615 $label = $ref->{"GotoRule"}; 3616 $lineno = $ref->{"LineNo"}; 3617 3618 if (exists($label2rule->{$label})) { 3619 3620 $id = $label2rule->{$label}; 3621 if ($id <= $i) { 3622 log_msg(LOG_WARN, "Rule in $conffile at line $lineno:", 3623 "can't go backwards to label $label, assuming continue=DontCont"); 3624 $ref->{"WhatNext"} = DONTCONT; 3625 $ref->{"GotoRule"} = $n; 3626 } else { $ref->{"GotoRule"} = $id; } 3627 3628 } else { 3629 log_msg(LOG_WARN, "Rule in $conffile at line $lineno:", 3630 "label $label does not exist, assuming continue=DontCont"); 3631 $ref->{"WhatNext"} = DONTCONT; 3632 $ref->{"GotoRule"} = $n; 3633 } 3634 3635 } elsif ($ref->{"WhatNext"} == TAKENEXT) { 3636 $ref->{"GotoRule"} = $i + 1; 3637 } elsif ($ref->{"WhatNext"} == DONTCONT) { 3638 $ref->{"GotoRule"} = $n; 3639 } elsif ($ref->{"WhatNext"} == ENDMATCH) { 3640 $ref->{"GotoRule"} = -1; 3641 } 3642 } 3643 3644 if (exists($ref->{"WhatNext2"})) { 3645 3646 if ($ref->{"WhatNext2"} == GOTO) { 3647 3648 $label = $ref->{"GotoRule2"}; 3649 $lineno = $ref->{"LineNo"}; 3650 3651 if (exists($label2rule->{$label})) { 3652 3653 $id = $label2rule->{$label}; 3654 if ($id <= $i) { 3655 log_msg(LOG_WARN, "Rule in $conffile at line $lineno:", 3656 "can't go backwards to label $label, assuming continue2=DontCont"); 3657 $ref->{"WhatNext2"} = DONTCONT; 3658 $ref->{"GotoRule2"} = $n; 3659 } else { $ref->{"GotoRule2"} = $id; } 3660 3661 } else { 3662 log_msg(LOG_WARN, "Rule in $conffile at line $lineno:", 3663 "label $label does not exist, assuming continue2=DontCont"); 3664 $ref->{"WhatNext2"} = DONTCONT; 3665 $ref->{"GotoRule2"} = $n; 3666 } 3667 3668 } elsif ($ref->{"WhatNext2"} == TAKENEXT) { 3669 $ref->{"GotoRule2"} = $i + 1; 3670 } elsif ($ref->{"WhatNext2"} == DONTCONT) { 3671 $ref->{"GotoRule2"} = $n; 3672 } elsif ($ref->{"WhatNext2"} == ENDMATCH) { 3673 $ref->{"GotoRule2"} = -1; 3674 } 3675 } 3676 3677 } 3678 } 3679} 3680 3681 3682# Parameters: par1 - name of the configuration file 3683# Action: read in rules from configuration file par1, so that leading 3684# and trailing whitespace is removed both from keywords and values 3685# of rule definions, and then call check_rule() for every rule. 3686# if all rules in the file are correctly defined, return 1, 3687# otherwise return 0 3688 3689sub read_configfile { 3690 3691 my($conffile) = $_[0]; 3692 my($fh, $linebuf, $line, $i, $cont, $rulestart); 3693 my($keyword, $value, $ret, $file_status); 3694 my(%rule, %label2rule); 3695 3696 $file_status = 1; # start with the assumption that all rules 3697 # are correctly defined 3698 3699 log_msg(LOG_NOTICE, "Reading configuration from $conffile"); 3700 3701 if (!open($fh, $conffile)) { 3702 log_msg(LOG_ERR, "Can't open configuration file $conffile ($!)"); 3703 return 0; 3704 } 3705 3706 $i = 0; 3707 $cont = 0; 3708 %rule = (); 3709 $rulestart = 1; 3710 %label2rule = (); 3711 3712 for (;;) { 3713 3714 # read next line from file 3715 3716 $linebuf = <$fh>; 3717 3718 # check if the line belongs to previous line; if it does, form a 3719 # single line from them and start the loop again (i.e. we will 3720 # concatenate lines until we read a line that does not end with '\') 3721 3722 if (defined($linebuf)) { 3723 3724 chomp($linebuf); 3725 3726 if ($cont) { $line .= $linebuf; } else { $line = $linebuf; } 3727 3728 # remove whitespaces from line beginnings and ends; 3729 # if line is all-whitespace, set it to empty string 3730 3731 if ($line =~ /^\s*(.*\S)/) { $line = $1; } else { $line = ""; } 3732 3733 # check if line ends with '\'; if it does, remove '\', set $cont 3734 # to 1 and jump at the start of loop to read next line, otherwise 3735 # set $cont to 0 3736 3737 if (substr($line, length($line) - 1) eq '\\') { 3738 chop($line); 3739 $cont = 1; 3740 next; 3741 } else { 3742 $cont = 0; 3743 } 3744 3745 } 3746 3747 # if the line constructed during previous loop is empty, starting 3748 # with #-symbol, or if we have reached EOF, consider that as the end 3749 # of current rule. Check the rule and set $rulestart to the next line. 3750 # If we have reached EOF, quit the loop, otherwise take the next line. 3751 3752 if (!defined($linebuf) || !length($line) 3753 || index($line, '#') == 0) { 3754 3755 if (scalar(%rule)) { 3756 $ret = check_rule(\%rule, $conffile, $rulestart, $i); 3757 if ($ret == 1) { ++$i; } 3758 elsif ($ret == 0) { $file_status = 0; } 3759 %rule = (); 3760 } 3761 3762 $rulestart = $. + 1; 3763 3764 if (defined($linebuf)) { next; } else { last; } 3765 3766 } 3767 3768 # split line into keyword and value 3769 3770 if ($line =~ /^\s*([[:alnum:]]+)\s*=\s*(.*\S)/) { 3771 $keyword = $1; 3772 $value = $2; 3773 } else { 3774 log_msg(LOG_ERR, "$conffile line $. ($line):", 3775 "Line not in keyword=value format or non-alphanumeric keyword"); 3776 $file_status = 0; 3777 next; 3778 } 3779 3780 # if the keyword is "label", save the number of currently unfinished 3781 # or upcoming rule definition to the hash %label2rule; 3782 # if the keyword is "rem", ignore it as a comment; 3783 # otherwise save the keyword and value to the hash %rule 3784 3785 if ($keyword eq "label") { $label2rule{$value} = $i; } 3786 elsif ($keyword ne "rem") { 3787 if (exists($rule{$keyword})) { 3788 log_msg(LOG_WARN, "Several '$keyword' keywords specified,", 3789 "overriding previous value '$rule{$keyword}' with '$value'"); 3790 } 3791 $rule{$keyword} = $value; 3792 } 3793 3794 } 3795 3796 # if valid rules were loaded, resolve 'continue=GoTo' labels 3797 3798 if ($i) { 3799 resolve_labels($conffile, \%label2rule); 3800 log_msg(LOG_DEBUG, "$i rules loaded from $conffile"); 3801 } else { 3802 log_msg(LOG_WARN, "No valid rules found in configuration file $conffile"); 3803 } 3804 3805 close($fh); 3806 3807 return $file_status; 3808 3809} 3810 3811 3812# Parameters: - 3813# Action: evaluate the conffile patterns given in commandline, form the 3814# list of configuration files and save it to global array 3815# @conffiles, and read in rules from the configuration files; 3816# also, create other global arrays for managing configuration 3817 3818sub read_config { 3819 3820 my($pattern, $conffile, $ret, $cfset); 3821 my(@stat, @rules, @files, %uniq); 3822 3823 # Set the $lastconfigload variable to reflect the current time 3824 3825 $lastconfigload = time(); 3826 3827 # Initialize global arrays %configuration, %config_ltimes, %config_mtimes, 3828 # %config_options, @calendar, @conffiles, %cfset2cfile, @maincfiles. 3829 # The @conffiles array holds the names of _all_ configuration files; 3830 # the members of @conffiles act as keys for the %configuration, 3831 # %config_ltimes, %config_mtimes and %config_options global hashes. 3832 # The %cfset2cfile hash creates a mapping between config fileset names 3833 # and file names - for each set name there is a file name list. 3834 # The files with rules accepting all input are stored to @mainfiles. 3835 3836 %configuration = (); 3837 %config_ltimes = (); 3838 %config_mtimes = (); 3839 %config_options = (); 3840 3841 @calendar = (); 3842 @conffiles = (); 3843 3844 %cfset2cfile = (); 3845 @maincfiles = (); 3846 3847 # Form the list of configuration files and save it to @conffiles; 3848 # repeated occurrences of the same file are discarded from the list 3849 3850 @files = (); 3851 foreach $pattern (@conffilepat) { push @files, glob($pattern); } 3852 3853 %uniq = (); 3854 @conffiles = grep(exists($uniq{$_})?0:($uniq{$_}=1), @files); 3855 3856 # Read the configuration from rule files and store it to the global 3857 # array %configuration; also, store mtimes and options of rule files to 3858 # the global arrays %config_mtimes and %config_options; save Calendar 3859 # rules to the global array Calendar and set the %cfset2cfile hash 3860 3861 $ret = 1; 3862 3863 foreach $conffile (@conffiles) { 3864 3865 $configuration{$conffile} = []; 3866 $config_ltimes{$conffile} = $lastconfigload; 3867 3868 @stat = stat($conffile); 3869 $config_mtimes{$conffile} = scalar(@stat)?$stat[9]:0; 3870 3871 $config_options{$conffile} = {}; 3872 3873 if (!read_configfile($conffile)) { $ret = 0; } 3874 3875 @rules = grep($_->{"Type"} == CALENDAR, @{$configuration{$conffile}}); 3876 push @calendar, @rules; 3877 3878 if (exists($config_options{$conffile}->{"CFSet"})) { 3879 while ($cfset = each (%{$config_options{$conffile}->{"CFSet"}})) { 3880 if (!exists($cfset2cfile{$cfset})) { $cfset2cfile{$cfset} = []; } 3881 push @{$cfset2cfile{$cfset}}, $conffile; 3882 } 3883 } 3884 3885 } 3886 3887 # Create the @maincfiles array - it holds the names of configuration 3888 # files that accept input from all sources, not from Jump rules only 3889 3890 @maincfiles = grep(!exists($config_options{$_}->{"JumpOnly"}), @conffiles); 3891 3892 return $ret; 3893 3894} 3895 3896 3897# Parameters: par1 - reference to an array where the names of modified 3898# and removed configuration files will be stored 3899# Action: evaluate the conffile patterns given in commandline, form the 3900# list of configuration files and save it to global array 3901# @conffiles; read in rules from the configuration files that are 3902# either new or have been modified since the last configuration 3903# load; also, create other global arrays for managing configuration. 3904# As its output, the function stores to the array par1 the names 3905# of configuration files that have been modified or removed since 3906# the last configuration load. 3907 3908sub soft_read_config { 3909 3910 my($file_list) = $_[0]; 3911 my($pattern, $conffile, $cfset); 3912 my(%old_config, %old_ltimes, %old_mtimes, %old_options); 3913 my(@old_conffiles, @stat, @rules, @files, %uniq); 3914 3915 # Back up global arrays %configuration, %config_ltimes, %config_mtimes, 3916 # and @conffiles 3917 3918 %old_config = %configuration; 3919 %old_ltimes = %config_ltimes; 3920 %old_mtimes = %config_mtimes; 3921 %old_options = %config_options; 3922 3923 @old_conffiles = @conffiles; 3924 3925 # Set the $lastconfigload variable to reflect the current time 3926 3927 $lastconfigload = time(); 3928 3929 # Initialize global arrays %configuration, %config_ltimes, %config_mtimes, 3930 # %config_options, @calendar, @conffiles, %cfset2cfile, @maincfiles. 3931 # The @conffiles array holds the names of _all_ configuration files; 3932 # the members of @conffiles act as keys for the %configuration, 3933 # %config_ltimes, %config_mtimes and %config_options global hashes. 3934 # The %cfset2cfile hash creates a mapping between config fileset names 3935 # and file names - for each set name there is a file name list. 3936 # The files with rules accepting all input are stored to @mainfiles. 3937 3938 %configuration = (); 3939 %config_ltimes = (); 3940 %config_mtimes = (); 3941 %config_options = (); 3942 3943 @calendar = (); 3944 @conffiles = (); 3945 3946 %cfset2cfile = (); 3947 @maincfiles = (); 3948 3949 # Form the list of configuration files and save it to @conffiles; 3950 # repeated occurrences of the same file are discarded from the list 3951 3952 @files = (); 3953 foreach $pattern (@conffilepat) { push @files, glob($pattern); } 3954 3955 %uniq = (); 3956 @conffiles = grep(exists($uniq{$_})?0:($uniq{$_}=1), @files); 3957 3958 # Read the configuration from rule files that are new or have been 3959 # modified and store it to the global array %configuration; store mtimes 3960 # and options of rule files to the global arrays %config_mtimes and 3961 # %config_options; save Calendar rules to the global array Calendar and 3962 # set the %cfset2cfile hash. 3963 # Also, store the names of modified configuration files to the array par1 3964 3965 @{$file_list} = (); 3966 3967 foreach $conffile (@conffiles) { 3968 3969 @stat = stat($conffile); 3970 $config_mtimes{$conffile} = scalar(@stat)?$stat[9]:0; 3971 3972 if (!exists($old_config{$conffile})) { 3973 3974 $configuration{$conffile} = []; 3975 $config_options{$conffile} = {}; 3976 read_configfile($conffile); 3977 $config_ltimes{$conffile} = $lastconfigload; 3978 3979 } elsif ($old_mtimes{$conffile} != $config_mtimes{$conffile}) { 3980 3981 $configuration{$conffile} = []; 3982 $config_options{$conffile} = {}; 3983 read_configfile($conffile); 3984 $config_ltimes{$conffile} = $lastconfigload; 3985 3986 push @{$file_list}, $conffile; 3987 3988 } else { 3989 3990 $configuration{$conffile} = $old_config{$conffile}; 3991 $config_options{$conffile} = $old_options{$conffile}; 3992 $config_ltimes{$conffile} = $old_ltimes{$conffile}; 3993 3994 } 3995 3996 @rules = grep($_->{"Type"} == CALENDAR, @{$configuration{$conffile}}); 3997 push @calendar, @rules; 3998 3999 if (exists($config_options{$conffile}->{"CFSet"})) { 4000 while ($cfset = each (%{$config_options{$conffile}->{"CFSet"}})) { 4001 if (!exists($cfset2cfile{$cfset})) { $cfset2cfile{$cfset} = []; } 4002 push @{$cfset2cfile{$cfset}}, $conffile; 4003 } 4004 } 4005 4006 } 4007 4008 # Create the @maincfiles array - it holds the names of configuration 4009 # files that accept input from all sources, not from Jump rules only 4010 4011 @maincfiles = grep(!exists($config_options{$_}->{"JumpOnly"}), @conffiles); 4012 4013 # Store the names of removed configuration files to the array par1 4014 4015 push @{$file_list}, grep(!exists($configuration{$_}), @old_conffiles); 4016 4017} 4018 4019 4020################################################ 4021# Functions related to execution of action lists 4022################################################ 4023 4024 4025# Parameters: - 4026# Action: set special action list variables for special characters 4027 4028sub set_actionlist_char_var { 4029 4030 my($i); 4031 4032 # setting %% variable to % ensures that all occurrences of %% are 4033 # substituted with % 4034 4035 $variables{"%"} = "%"; 4036 4037 # set other action list variables for various special characters 4038 4039 $variables{".nl"} = "\n"; 4040 $variables{".cr"} = "\r"; 4041 $variables{".tab"} = "\t"; 4042 $variables{".sp"} = " "; 4043 4044 for ($i = 0; $i < 32; ++$i) { $variables{".chr$i"} = chr($i); } 4045 4046} 4047 4048 4049# Parameters: par1 - timestamp (seconds since Epoch) 4050# Action: set special action list variables for timestamp par1 4051 4052sub set_actionlist_time_var { 4053 4054 my(@ltime) = localtime($_[0]); 4055 4056 $variables{".sec"} = ($ltime[0] < 10)?("0" . $ltime[0]):$ltime[0]; 4057 4058 $variables{".min"} = ($ltime[1] < 10)?("0" . $ltime[1]):$ltime[1]; 4059 4060 $variables{".hour"} = ($ltime[2] < 10)?("0" . $ltime[2]):$ltime[2]; 4061 4062 $variables{".hmsstr"} = $variables{".hour"} . ":" . $variables{".min"} 4063 . ":" . $variables{".sec"}; 4064 4065 if ($ltime[3] < 10) { 4066 $variables{".mday"} = "0" . $ltime[3]; 4067 $variables{".mdaystr"} = " " . $ltime[3]; 4068 } else { 4069 $variables{".mday"} = $ltime[3]; 4070 $variables{".mdaystr"} = $ltime[3]; 4071 } 4072 4073 $variables{".mon"} = ($ltime[4] < 9)?("0" . ($ltime[4]+1)):$ltime[4]+1; 4074 4075 $variables{".monstr"} = POSIX::strftime("%b", @ltime); 4076 4077 $variables{".year"} = $ltime[5] + 1900; 4078 4079 $variables{".wday"} = $ltime[6]; 4080 4081 $variables{".wdaystr"} = POSIX::strftime("%a", @ltime); 4082 4083 $variables{".tzname"} = POSIX::strftime("%Z", @ltime); 4084 4085 $variables{".tzoff"} = POSIX::strftime("%z", @ltime); 4086 4087 if ($variables{".tzoff"} =~ /^([+-][0-9]{2})([0-9]{2})$/) { 4088 $variables{".tzoff2"} = "$1:$2"; 4089 } else { 4090 $variables{".tzoff2"} = ""; 4091 } 4092 4093} 4094 4095 4096# Parameters: par1 - string 4097# par2 - string 4098# Action: all action list variables in string par1 will be replaced with 4099# their values; string par2 will be assigned to special variable %s 4100 4101sub substitute_actionlist_var { 4102 4103 if (index($_[0], "%") == -1) { return; } 4104 4105 my($time) = time(); 4106 4107 # if builtin time-based action list variables do not reflect the current 4108 # second, set these variables to proper values 4109 4110 if ($time != $timevar_update) { 4111 set_actionlist_time_var($time); 4112 $timevar_update = $time; 4113 } 4114 4115 # since %u and %t variables can be modified from actions (e.g., 'assign'), 4116 # they are set to proper values before each substitution 4117 4118 $variables{"u"} = $time; 4119 $variables{"t"} = localtime($time); 4120 4121 # set %s variable to operation description string (second parameter) 4122 4123 $variables{"s"} = $_[1]; 4124 4125 # substitute all action list variables 4126 4127 $_[0] =~ s/%(?:(\.?[[:alpha:]]\w*|%)|\{(\.?[[:alpha:]]\w*)\})/ 4128 defined($variables{$+})?$variables{$+}:""/egx; 4129 4130} 4131 4132 4133# Parameters: par1 - commandline 4134# par2 - 'collect output' flag 4135# par3 - context 4136# Action: commandline par1 is executed with perl exec() in a child process. 4137# If par1 is a reference to an array, commandline in array is 4138# executed without shell interpretation; otherwise commandline is 4139# interpreted with shell if it contains shell metacharacters. 4140# The function creates an entry in the %children hash for the child 4141# process and returns its pid. If process creation failed, undef is 4142# returned. If par2 is defined and non-zero, standard output of the 4143# commandline is returned to the main process through a pipe. If par3 4144# is also defined, commandline's standard output is returned with an 4145# internal context par3 (otherwise default internal context is used). 4146 4147sub exec_cmd { 4148 4149 my($cmdline, $collect_output, $context) = @_; 4150 my($cmd, $shell, $pid, $read, $write); 4151 4152 # if the commandline has been provided as a reference to an array, 4153 # configure its execution without shell interpretation; also, set 4154 # $cmd variable to the entire commandline string 4155 4156 if (ref($cmdline) eq "ARRAY") { 4157 $cmd = join(" ", @{$cmdline}); 4158 $shell = 0; 4159 } else { 4160 $cmd = $cmdline; 4161 $shell = 1; 4162 } 4163 4164 # set up a pipe before calling fork() 4165 4166 if ($collect_output && !pipe($read, $write)) { 4167 log_msg(LOG_ERR, "Could not create pipe for command '$cmd' ($!)"); 4168 return undef; 4169 } 4170 4171 # try to create a child process and return undef, if fork failed; 4172 # if fork was successful and we are in parent process, return the 4173 # pid of the child process 4174 4175 $pid = fork(); 4176 4177 if (!defined($pid)) { 4178 4179 if ($collect_output) { 4180 close($read); 4181 close($write); 4182 } 4183 4184 log_msg(LOG_ERR, "Could not fork command '$cmd' ($!)"); 4185 return undef; 4186 4187 } elsif ($pid) { 4188 4189 $children{$pid} = { "cmd" => $cmd, 4190 "fh" => undef, 4191 "open" => 0, 4192 "buffer" => "", 4193 "Desc" => undef, 4194 "Action" => undef, 4195 "Action2" => undef }; 4196 4197 if ($collect_output) { 4198 close($write); 4199 $children{$pid}->{"fh"} = $read; 4200 $children{$pid}->{"open"} = 1; 4201 $children{$pid}->{"context"} = 4202 defined($context)?$context:SYNEVENT_INT_CONTEXT; 4203 } 4204 4205 log_msg(LOG_DEBUG, "Child $pid created for command '$cmd'"); 4206 return $pid; 4207 4208 } 4209 4210 # we are in the child process now... 4211 4212 if ($collect_output) { 4213 4214 # close the read end of the pipe and connect the standard output of 4215 # the child process to the write end of the pipe 4216 4217 close($read); 4218 if (!open(STDOUT, ">&", $write)) { exit(1); } 4219 close($write); 4220 } 4221 4222 # set SIGPIPE handling back to default before calling exec() (SIGPIPE is 4223 # ignored and exec() will only reset custom signal handlers to default) 4224 4225 $SIG{PIPE} = 'DEFAULT'; 4226 4227 # set SIGTERM handling back to default (terminate) before calling exec(); 4228 # if this process has received SIGTERM before default handling became 4229 # active, terminate the process without calling exec() 4230 4231 $SIG{TERM} = 'DEFAULT'; 4232 4233 if (exists($terminate{$$})) { exit(0); } 4234 4235 # execute commandline - by default exec() keeps file descriptors 0..2 open 4236 # and closes other descriptors (see $^F special variable in perl docs); 4237 # if commandline must be executed without shell interpretation, call 4238 # exec() with list of commandline arguments and provide the first element 4239 # of the list as indirect object { $cmdline->[0] } (that disables shell 4240 # interpretation even if list has one element) 4241 4242 if ($shell) { 4243 exec($cmdline); 4244 } else { 4245 exec { $cmdline->[0] } @{$cmdline}; 4246 } 4247 4248 exit(1); 4249 4250} 4251 4252 4253# Parameters: par1 - commandline 4254# par2 - reference to a hash or an array 4255# Action: this function creates two processes for executing commandline par1. 4256# The child process writes the contents of array par2 (or keys of hash 4257# par2) to the standard input of the commandline through a pipe. 4258# Writing is synchronous (blocking) and hence the need for a separate 4259# process. The grandchild has its standard input connected to the read 4260# end of the pipe and executes the commandline with perl exec(). 4261# If par1 is a reference to an array, commandline in array is 4262# executed without shell interpretation; otherwise commandline is 4263# interpreted with shell if it contains shell metacharacters. 4264# The function creates an entry in the %children hash for the child 4265# process and returns its pid. If child process creation failed, undef 4266# is returned. After the commandline has completed, the child process 4267# terminates and returns grandchild exit code for its own exit value. 4268 4269sub pipe_cmd { 4270 4271 my($cmdline, $ref) = @_; 4272 my($cmd, $shell, $pid, $read, $write, $elem, $p); 4273 4274 # if the commandline has been provided as a reference to an array, 4275 # configure its execution without shell interpretation; also, set 4276 # $cmd variable to the entire commandline string 4277 4278 if (ref($cmdline) eq "ARRAY") { 4279 $cmd = join(" ", @{$cmdline}); 4280 $shell = 0; 4281 } else { 4282 $cmd = $cmdline; 4283 $shell = 1; 4284 } 4285 4286 # try to create a child process and return undef, if fork failed; 4287 # if fork was successful and we are in parent process, return the 4288 # pid of the child process 4289 4290 $pid = fork(); 4291 4292 if (!defined($pid)) { 4293 4294 log_msg(LOG_ERR, "Could not fork command '$cmd' ($!)"); 4295 return undef; 4296 4297 } elsif ($pid) { 4298 4299 $children{$pid} = { "cmd" => $cmd, 4300 "fh" => undef, 4301 "open" => 0, 4302 "buffer" => "", 4303 "Desc" => undef, 4304 "Action" => undef, 4305 "Action2" => undef }; 4306 4307 log_msg(LOG_DEBUG, "Child $pid created for command '$cmd'"); 4308 return $pid; 4309 4310 } 4311 4312 # we are in the child process now... 4313 # create a pipe for communicating with the commandline 4314 4315 if (!pipe($read, $write)) { exit(1); } 4316 4317 # Fork a process for commandline with pipe connected to its standard input. 4318 # open(pipe, "| cmd") with blocking close(pipe) that returns child exit code 4319 # are not used - if SIGTERM interrupts blocking close(pipe) and triggers 4320 # exit(0) from its handler, many perl versions produce the warning "refcnt: 4321 # fd -1 < 0", because exit() attempts to close the pipe for the second time. 4322 4323 $pid = fork(); 4324 if (!defined($pid)) { exit(1); } 4325 4326 if (!$pid) { 4327 4328 # we are in the grandchild process now... close the write end of 4329 # the pipe and connect the standard input to the read end of the pipe 4330 4331 close($write); 4332 if (!open(STDIN, "<&", $read)) { exit(1); } 4333 close($read); 4334 4335 # set SIGPIPE handling back to default before calling exec() (SIGPIPE is 4336 # ignored and exec() will only reset custom signal handlers to default) 4337 4338 $SIG{PIPE} = 'DEFAULT'; 4339 4340 # set SIGTERM handling back to default (terminate) before calling exec(); 4341 # if this process has received SIGTERM before default handling became 4342 # active, terminate the process without calling exec() 4343 4344 $SIG{TERM} = 'DEFAULT'; 4345 4346 if (exists($terminate{$$})) { exit(0); } 4347 4348 # execute commandline - by default exec() keeps file descriptors 0..2 open 4349 # and closes other descriptors (see $^F special variable in perl docs); 4350 # if commandline must be executed without shell interpretation, call 4351 # exec() with list of commandline arguments and provide the first element 4352 # of the list as indirect object { $cmdline->[0] } (that disables shell 4353 # interpretation even if list has one element) 4354 4355 if ($shell) { 4356 exec($cmdline); 4357 } else { 4358 exec { $cmdline->[0] } @{$cmdline}; 4359 } 4360 4361 exit(1); 4362 } 4363 4364 # we are in the child process now (grandchild is our child)... 4365 # close the read end of the pipe and make the write end unbuffered 4366 4367 close($read); 4368 select($write); 4369 $| = 1; 4370 4371 # Set a new signal handler for SIGTERM that forwards it to child process 4372 # and exits. Since the handler could be triggered after blocking waitpid() 4373 # has returned and reaped the child from process table, the presence of 4374 # child is verified with nonblocking waitpid() before forwarding SIGTERM. 4375 # If the current process has received SIGTERM before the new handler became 4376 # active, forward SIGTERM to child process and exit (child must exist since 4377 # waitpid() has not been called yet for child). 4378 4379 $SIG{TERM} = sub { my($ret) = waitpid($pid, WNOHANG); 4380 if ($ret == -1) { exit(0); } 4381 if ($ret != 0 && ($WIN32 || WIFEXITED($?) || 4382 WIFSIGNALED($?))) { exit(0); } 4383 kill('TERM', $pid); 4384 exit(0); }; 4385 4386 if (exists($terminate{$$})) { 4387 kill('TERM', $pid); 4388 exit(0); 4389 } 4390 4391 # since this process does not call exec() which closes all file descriptors 4392 # apart from 0..2 (see $^F special variable in perl docs), close all inputs, 4393 # outputs, the logfile, and connection to the system logger (if this is not 4394 # done, removed input/output files and connections established over sockets 4395 # would be kept open even after the parent process has closed them) 4396 4397 %inputsrc = (); 4398 4399 close_outputs(); 4400 4401 if ($logopen) { close($loghandle); } 4402 if ($syslogopen) { eval { Sys::Syslog::closelog() }; } 4403 4404 # write data to pipe in blocking mode (ignoring SIGPIPE is inherited from 4405 # the main SEC process and writing to pipe is thus safe) 4406 4407 if (ref($ref) eq "HASH") { 4408 while ($elem = each(%{$ref})) { print $write $elem, "\n"; } 4409 } else { 4410 foreach $elem (@{$ref}) { print $write $elem, "\n"; } 4411 } 4412 4413 # close the pipe immediately after writing (many commands don't terminate 4414 # without seeing EOF in stdin and without close() there would be deadlock) 4415 4416 close($write); 4417 4418 for (;;) { 4419 4420 # wait for child process in blocking mode; waitpid() returns the pid 4421 # of the exited child process, return value -1 means there is no child 4422 # process with the given pid, while 0 means the child is still running 4423 4424 $p = waitpid($pid, 0); 4425 4426 # call exit(1) if according to waitpid() the child does not exist (i.e., 4427 # its exit code has already been collected which should never happen) 4428 4429 if ($p == -1) { exit(1); } 4430 4431 # if the child has exited, return its exit code with exit() 4432 4433 if ($p != 0 && ($WIN32 || WIFEXITED($?) || WIFSIGNALED($?))) { 4434 exit($? >> 8); 4435 } 4436 } 4437 4438} 4439 4440 4441# Parameters: par1 - host 4442# par2 - port 4443# par3 - protocol 4444# Action: Create the socket and address information data structure for 4445# communicating with remote peer at host par1 and port par2 over 4446# protocol par3. On success, return socket filehandle and address 4447# information data structure, otherwise return undef. 4448 4449sub create_sock_addr { 4450 4451 my($host, $port, $proto) = @_; 4452 my($handle, $socktype, $iaddr, $paddr, $errlogged); 4453 my($err, $addrinfo, @addrinfo, %hints); 4454 4455 # set the socket type according to protocol 4456 4457 if ($proto eq "tcp") { $socktype = SOCK_STREAM; } 4458 elsif ($proto eq "udp") { $socktype = SOCK_DGRAM; } 4459 else { 4460 log_msg(LOG_ERR, "Creating sockets for protocol $proto is not supported"); 4461 return undef; 4462 } 4463 4464 # if perl Socket module has getaddrinfo() function which supports both 4465 # ipv4 and ipv6, use it for creating the socket; if we are dealing with 4466 # older perl version where Socket module comes without getaddrinfo(), use 4467 # traditional ipv4-only inet_aton() based approach for creating the socket 4468 4469 if (defined(&Socket::getaddrinfo)) { 4470 4471 # set up the hints data structure for getaddrinfo() -- note that 4472 # if socket type is not provided as a hint, getaddrinfo() returns 4473 # an error on some platforms if service port specification is not 4474 # textual but numeric 4475 4476 $hints{"socktype"} = $socktype; 4477 $hints{"protocol"} = getprotobyname($proto); 4478 4479 ($err, @addrinfo) = Socket::getaddrinfo($host, $port, \%hints); 4480 4481 if ($err) { 4482 log_msg(LOG_WARN, "Can't create socket for $host:$port/$proto ($err)"); 4483 return undef; 4484 } 4485 4486 # go through addrinfo list and try to create sockets for list elements, 4487 # returning the first successfully created socket (an attempt for first 4488 # list element might not always succeed, e.g., consider a scenario 4489 # where the first element represents an ipv6 address and the second 4490 # element ipv4 address, while the local host only supports ipv4) 4491 4492 $paddr = undef; 4493 $errlogged = 0; 4494 4495 foreach $addrinfo (@addrinfo) { 4496 4497 if (!socket($handle, $addrinfo->{"family"}, 4498 $addrinfo->{"socktype"}, 4499 $addrinfo->{"protocol"})) { 4500 $errlogged = 1; 4501 log_msg(LOG_ERR, "Can't create socket for $host:$port/$proto ($!)"); 4502 next; 4503 } 4504 4505 $paddr = $addrinfo->{"addr"}; 4506 last; 4507 } 4508 4509 # if the creation of the socket failed in the above loop, return undef 4510 4511 if (!defined($paddr)) { return undef; } 4512 4513 # if socket was successfully created in the above loop, but one (or more) 4514 # loop iteration(s) failed and produced error message(s), log a message 4515 # about successful creation of the socket 4516 4517 if ($errlogged) { 4518 log_msg(LOG_DEBUG, "Socket for $host:$port/$proto successfully created"); 4519 } 4520 4521 } else { 4522 4523 $iaddr = inet_aton($host); 4524 4525 if (!defined($iaddr)) { 4526 log_msg(LOG_WARN, "Can't create socket for $host:$port/$proto", 4527 "(unable to convert $host to Internet address)"); 4528 return undef; 4529 } 4530 4531 $paddr = sockaddr_in($port, $iaddr); 4532 4533 if (!socket($handle, PF_INET, $socktype, getprotobyname($proto))) { 4534 log_msg(LOG_ERR, "Can't create socket for $host:$port/$proto ($!)"); 4535 return undef; 4536 } 4537 4538 } 4539 4540 return ($handle, $paddr); 4541 4542} 4543 4544 4545# Parameters: par1 - handle of the socket 4546# par2 - event 4547# par3 - name of the destination 4548# Action: Send event par2 to socket par1 with the send(2) system call, and 4549# produce a log message in the case of an error. In the log message, 4550# par3 reflects the destination, and the message is logged with debug 4551# level, in order to prevent message floods with higher severity when 4552# large amounts of data are transfered. Return 0 if send(2) failed, 4553# so that the socket should be closed; return 1 if event was partially 4554# transmitted or could not be transmitted due to perl wide characters 4555# or insufficient buffer space; return 2 on successful transmission. 4556 4557sub send_to_socket { 4558 4559 my($socket, $event, $dest) = @_; 4560 my($nbytes); 4561 4562 for (;;) { 4563 4564 # if the event contains perl wide characters, send() will die, 4565 # thus eval is used for calling it; according to posix, EWOULDBLOCK 4566 # or EAGAIN indicates that the socket buffer is full, while EMSGSIZE 4567 # means that the message is too large for the given socket type 4568 4569 $nbytes = eval { send($socket, $event, 0) }; 4570 4571 if ($@) { 4572 log_msg(LOG_DEBUG, "Error when sending event '$event' to $dest ($@)"); 4573 return 1; 4574 } elsif (!defined($nbytes)) { 4575 if ($! == EINTR) { next; } 4576 log_msg(LOG_DEBUG, "Error when sending event '$event' to $dest ($!)"); 4577 if ($! == EWOULDBLOCK || $! == EAGAIN || $! == EMSGSIZE) { return 1; } 4578 return 0; 4579 } elsif ($nbytes != length($event)) { 4580 log_msg(LOG_DEBUG, "$nbytes bytes of '$event' sent to $dest"); 4581 return 1; 4582 } else { 4583 return 2; 4584 } 4585 4586 } 4587} 4588 4589 4590# Parameters: par1 - handle of the socket 4591# par2 - operation type (0 denotes reading and 1 writing) 4592# Action: Check if socket par1 is ready for operation par2 (i.e., whether 4593# the socket is ready for reading or writing); return 1 if socket 4594# par1 is ready for operation par2, otherwise return 0 4595 4596sub socket_ready { 4597 4598 my($socket, $operation) = @_; 4599 my($bitmask, $ret); 4600 4601 for (;;) { 4602 4603 # create the bitmask for socket handle 4604 4605 $bitmask = ''; 4606 vec($bitmask, fileno($socket), 1) = 1; 4607 4608 # poll the socket with select() if it is ready for reading or writing 4609 4610 if ($operation) { $ret = select(undef, $bitmask, undef, 0); } 4611 else { $ret = select($bitmask, undef, undef, 0); } 4612 4613 # if select() fails with EINTR, try again, otherwise quit the polling 4614 4615 if ((!defined($ret) || $ret < 0) && $! == EINTR) { next; } else { last; } 4616 } 4617 4618 # if the socket is ready, return 1, otherwise return 0 4619 4620 if (defined($ret) && $ret > 0) { return 1; } else { return 0; } 4621} 4622 4623 4624# Parameters: par1 - reference to the socket hash table for new connections 4625# par2 - reference to the socket hash table for connections with 4626# completed establishment 4627# par3 - peer ID that identifies socket in tables par1 and par2 4628# par4 - textual peer type 4629# Action: Check the status of a connection which is not yet established and 4630# corresponds to socket par3 in table par1. If the establishment of 4631# the connection is complete, move the socket par3 from table par1 4632# to table par2. Textual peer type par4 and peer ID par3 are used 4633# in error log messages, and messages are logged with debug level, 4634# in order to prevent message floods with higher severity when large 4635# amounts of data are transfered. 4636 4637sub check_new_conn { 4638 4639 my($new_sockets, $est_sockets, $peer, $peertype) = @_; 4640 my($event); 4641 4642 # Check if socket is writable (indicates that connection establishment 4643 # has completed either successfully or with error). 4644 # If the establishment is still incomplete and the establishment timeout 4645 # has been reached, close the socket, drop all previously buffered data, 4646 # and return. If the establishment timeout has not been reached, return. 4647 4648 if (!socket_ready($new_sockets->{$peer}->{"socket"}, 1)) { 4649 4650 if (time() - $new_sockets->{$peer}->{"time"} > $socket_timeout) { 4651 log_msg(LOG_DEBUG, "Can't connect to $peertype '$peer'", 4652 "(connection establishment timeout)"); 4653 delete $new_sockets->{$peer}; 4654 } 4655 4656 return; 4657 } 4658 4659 # If socket is writable, try to transmit all buffered events. 4660 # In the case of hard errors from send(2), retransmission is not attempted 4661 # and data are not buffered, but socket is closed (note that if connection 4662 # establishment completed with error, sending the first buffered event will 4663 # produce a hard send(2) error and socket will be closed). 4664 4665 foreach $event (@{$new_sockets->{$peer}->{"buffer"}}) { 4666 4667 if (!send_to_socket($new_sockets->{$peer}->{"socket"}, $event, 4668 "$peertype '$peer'")) { 4669 delete $new_sockets->{$peer}; 4670 return; 4671 } 4672 } 4673 4674 $est_sockets->{$peer} = $new_sockets->{$peer}->{"socket"}; 4675 delete $new_sockets->{$peer}; 4676} 4677 4678 4679# Parameters: par1 - reference to a list of actions 4680# par2 - event description text 4681# par3 - pointer into the list of actions 4682# Action: execute an action from a given action list, and return 4683# an offset for advancing the pointer par3 4684 4685sub execute_none_action { return 1; } 4686 4687sub execute_logonly_action { 4688 4689 my($actionlist, $text, $i) = @_; 4690 my($event); 4691 4692 $event = $actionlist->[$i+1]; 4693 substitute_actionlist_var($event, $text); 4694 log_msg(LOG_NOTICE, $event); 4695 4696 return 2; 4697} 4698 4699sub execute_write_action { 4700 4701 my($actionlist, $text, $i) = @_; 4702 my($action, $file, $event); 4703 my($handle, $nbytes, $len); 4704 4705 # since this function is used for both 'write' and 'writen' actions, 4706 # set $action to the action type 4707 $action = $actionlist->[$i]; 4708 4709 $file = $actionlist->[$i+1]; 4710 $event = $actionlist->[$i+2]; 4711 4712 substitute_actionlist_var($file, $text); 4713 substitute_actionlist_var($event, $text); 4714 4715 # apart from unexpected local system errors, communication errors are 4716 # logged at the debug level, in order to prevent message floods with 4717 # higher severity when larger amounts of data are transfered 4718 4719 log_msg(LOG_DEBUG, "Writing event '$event' to file '$file'"); 4720 4721 if (!exists($output_files{$file})) { 4722 4723 if ($file eq "-") { 4724 4725 while (!open($handle, ">&STDOUT")) { 4726 if ($! == EINTR) { next; } 4727 log_msg(LOG_ERR, "Can't dup stdout for writing event '$event' ($!)"); 4728 return 3; 4729 } 4730 $output_files{$file} = $handle; 4731 4732 } elsif (-e $file && ! -f $file && ! -p $file) { 4733 4734 log_msg(LOG_DEBUG, "Can't write event '$event' to file '$file'", 4735 "(not a regular file or pipe)"); 4736 return 3; 4737 4738 } elsif (-p $file) { 4739 4740 while (!sysopen($handle, $file, O_WRONLY | O_NONBLOCK)) { 4741 if ($! == EINTR) { next; } 4742 log_msg(LOG_DEBUG, "Can't open '$file' for writing event '$event' ($!)"); 4743 return 3; 4744 } 4745 $output_files{$file} = $handle; 4746 4747 } else { 4748 4749 while (!sysopen($handle, $file, O_WRONLY | O_CREAT | O_APPEND)) { 4750 if ($! == EINTR) { next; } 4751 log_msg(LOG_DEBUG, "Can't open '$file' for writing event '$event' ($!)"); 4752 return 3; 4753 } 4754 $output_files{$file} = $handle; 4755 4756 } 4757 } 4758 4759 for (;;) { 4760 4761 # if the event contains perl wide characters, syswrite() will die, 4762 # thus eval is used for calling it 4763 4764 if ($action == WRITE) { 4765 $len = length($event) + 1; 4766 $nbytes = eval { syswrite($output_files{$file}, "$event\n") }; 4767 } else { 4768 $len = length($event); 4769 $nbytes = eval { syswrite($output_files{$file}, "$event") }; 4770 } 4771 4772 if ($@) { 4773 log_msg(LOG_DEBUG, "Error when writing event '$event' to '$file' ($@)"); 4774 } elsif (!defined($nbytes)) { 4775 if ($! == EINTR) { next; } 4776 log_msg(LOG_DEBUG, "Error when writing event '$event' to '$file' ($!)"); 4777 delete $output_files{$file}; 4778 } elsif ($nbytes != $len) { 4779 log_msg(LOG_DEBUG, "$nbytes bytes of '$event' written to '$file'"); 4780 } 4781 4782 return 3; 4783 } 4784} 4785 4786sub execute_closef_action { 4787 4788 my($actionlist, $text, $i) = @_; 4789 my($file); 4790 4791 $file = $actionlist->[$i+1]; 4792 substitute_actionlist_var($file, $text); 4793 4794 log_msg(LOG_DEBUG, "Closing file '$file'"); 4795 4796 if (exists($output_files{$file})) { 4797 if (!close($output_files{$file})) { 4798 log_msg(LOG_WARN, "Error when closing file '$file' ($!)"); 4799 } 4800 delete $output_files{$file}; 4801 } else { 4802 log_msg(LOG_DEBUG, "File '$file' is not open, can't close"); 4803 } 4804 4805 return 2; 4806} 4807 4808sub execute_owritecl_action { 4809 4810 my($actionlist, $text, $i) = @_; 4811 my($file, $event, $handle, $nbytes); 4812 4813 $file = $actionlist->[$i+1]; 4814 $event = $actionlist->[$i+2]; 4815 4816 substitute_actionlist_var($file, $text); 4817 substitute_actionlist_var($event, $text); 4818 4819 # apart from unexpected local system errors, communication errors are 4820 # logged at the debug level, in order to prevent message floods with 4821 # higher severity when larger amounts of data are transfered 4822 4823 log_msg(LOG_DEBUG, "Writing event '$event' to file '$file'"); 4824 4825 if ($file eq "-") { 4826 4827 select(STDOUT); 4828 $| = 1; 4829 print STDOUT "$event"; 4830 return 3; 4831 4832 } elsif (-e $file && ! -f $file && ! -p $file) { 4833 4834 log_msg(LOG_DEBUG, "Can't write event '$event' to file '$file'", 4835 "(not a regular file or pipe)"); 4836 return 3; 4837 4838 } elsif (-p $file) { 4839 4840 while (!sysopen($handle, $file, O_WRONLY | O_NONBLOCK)) { 4841 if ($! == EINTR) { next; } 4842 log_msg(LOG_DEBUG, "Can't open '$file' for writing event '$event' ($!)"); 4843 return 3; 4844 } 4845 4846 } else { 4847 4848 while (!sysopen($handle, $file, O_WRONLY | O_CREAT | O_APPEND)) { 4849 if ($! == EINTR) { next; } 4850 log_msg(LOG_DEBUG, "Can't open '$file' for writing event '$event' ($!)"); 4851 return 3; 4852 } 4853 } 4854 4855 for (;;) { 4856 4857 # if the event contains perl wide characters, syswrite() will die, 4858 # thus eval is used for calling it 4859 4860 $nbytes = eval { syswrite($handle, $event) }; 4861 4862 if ($@) { 4863 log_msg(LOG_DEBUG, "Error when writing event '$event' to '$file' ($@)"); 4864 } elsif (!defined($nbytes)) { 4865 if ($! == EINTR) { next; } 4866 log_msg(LOG_DEBUG, "Error when writing event '$event' to '$file' ($!)"); 4867 } elsif ($nbytes != length($event)) { 4868 log_msg(LOG_DEBUG, "$nbytes bytes of '$event' written to '$file'"); 4869 } 4870 4871 close($handle); 4872 return 3; 4873 } 4874} 4875 4876sub execute_udgram_action { 4877 4878 my($actionlist, $text, $i) = @_; 4879 my($file, $event, $handle); 4880 4881 $file = $actionlist->[$i+1]; 4882 $event = $actionlist->[$i+2]; 4883 4884 substitute_actionlist_var($file, $text); 4885 substitute_actionlist_var($event, $text); 4886 4887 # apart from unexpected local system errors, communication errors with 4888 # local peers are logged at the debug level, in order to prevent message 4889 # floods with higher severity when large amounts of data are transfered 4890 4891 log_msg(LOG_DEBUG, "Sending event '$event' to unix datagram socket '$file'"); 4892 4893 # if the socket already exists, use it for transmitting data; if the 4894 # transmission fails with hard error from send(2) (e.g., the server has 4895 # been restarted and the socket file has been recreated), close the socket 4896 # and attempt retransmission, otherwise return immediately 4897 4898 if (exists($output_udgram{$file})) { 4899 4900 if (send_to_socket($output_udgram{$file}, $event, "socket '$file'")) { 4901 return 3; 4902 } 4903 4904 log_msg(LOG_DEBUG, "Retrying to send event '$event' to socket '$file'"); 4905 delete $output_udgram{$file}; 4906 } 4907 4908 # create the socket for communicating with local peer 4909 4910 if (! -S $file) { 4911 log_msg(LOG_DEBUG, "Can't send event '$event' to socket '$file'", 4912 "(socket does not exist)"); 4913 return 3; 4914 } 4915 4916 if (!socket($handle, PF_UNIX, SOCK_DGRAM, 0)) { 4917 log_msg(LOG_ERR, "Can't create socket for sending event '$event' ($!)"); 4918 return 3; 4919 } 4920 4921 # Connect to local peer (connect() returns immediately for connectionless 4922 # sockets). Since EINTR error should not happen for connectionless sockets 4923 # on posix systems and on many platforms connect() should not be called 4924 # again after EINTR, there is no special handling for EINTR. 4925 4926 if (!connect($handle, sockaddr_un($file))) { 4927 log_msg(LOG_DEBUG, 4928 "Can't connect to socket '$file' for sending event '$event' ($!)"); 4929 return 3; 4930 } 4931 4932 # switch the socket to non-blocking mode for all further communications 4933 4934 $handle->blocking(0); 4935 $output_udgram{$file} = $handle; 4936 4937 # transmit data to local peer (close the socket on hard send(2) error) 4938 4939 if (!send_to_socket($output_udgram{$file}, $event, "socket '$file'")) { 4940 delete $output_udgram{$file}; 4941 } 4942 4943 return 3; 4944} 4945 4946sub execute_closeudgr_action { 4947 4948 my($actionlist, $text, $i) = @_; 4949 my($file); 4950 4951 $file = $actionlist->[$i+1]; 4952 substitute_actionlist_var($file, $text); 4953 4954 log_msg(LOG_DEBUG, "Closing unix datagram socket '$file'"); 4955 4956 if (exists($output_udgram{$file})) { 4957 if (!close($output_udgram{$file})) { 4958 log_msg(LOG_WARN, "Error when closing socket '$file' ($!)"); 4959 } 4960 delete $output_udgram{$file}; 4961 } else { 4962 log_msg(LOG_DEBUG, "Socket '$file' is not open, can't close"); 4963 } 4964 4965 return 2; 4966} 4967 4968sub execute_ustream_action { 4969 4970 my($actionlist, $text, $i) = @_; 4971 my($file, $event, $handle); 4972 4973 $file = $actionlist->[$i+1]; 4974 $event = $actionlist->[$i+2]; 4975 4976 substitute_actionlist_var($file, $text); 4977 substitute_actionlist_var($event, $text); 4978 4979 # apart from unexpected local system errors, communication errors with 4980 # local peers are logged at the debug level, in order to prevent message 4981 # floods with higher severity when large amounts of data are transfered 4982 4983 log_msg(LOG_DEBUG, "Sending event '$event' to unix stream socket '$file'"); 4984 4985 # If the socket exists and there is an established connection to local 4986 # peer, send data to the peer. If sending failed with a hard error from 4987 # send(2), close the socket and attempt resending with a newly created 4988 # socket later in the function, otherwise return immediately. 4989 4990 if (exists($output_ustream{$file})) { 4991 4992 if (send_to_socket($output_ustream{$file}, $event, "socket '$file'")) { 4993 return 3; 4994 } 4995 4996 log_msg(LOG_DEBUG, "Retrying to send event '$event' to socket '$file'"); 4997 delete $output_ustream{$file}; 4998 } 4999 5000 # the socket exists but the connection establishment is not complete 5001 5002 elsif (exists($output_ustrconn{$file})) { 5003 5004 # buffer the event 5005 5006 push @{$output_ustrconn{$file}->{"buffer"}}, $event; 5007 5008 # Check the status of the connection, and if the connection establishment 5009 # has completed, try to transmit all buffered events. If no hard send(2) 5010 # errors were encountered during transmission, regard the connection as 5011 # successfully established, and move the socket from %output_ustrconn hash 5012 # to %output_ustream hash. Otherwise, close the socket. 5013 5014 check_new_conn(\%output_ustrconn, \%output_ustream, $file, "socket"); 5015 5016 return 3; 5017 } 5018 5019 # If the socket did not exist previously or the established connection 5020 # was closed because of an error, recreate the socket and attempt to 5021 # establish a new connection for transmitting data to local peer 5022 5023 if (! -S $file) { 5024 log_msg(LOG_DEBUG, "Can't send event '$event' to socket '$file'", 5025 "(socket does not exist)"); 5026 return 3; 5027 } 5028 5029 if (!socket($handle, PF_UNIX, SOCK_STREAM, 0)) { 5030 log_msg(LOG_ERR, "Can't create socket for sending event '$event' ($!)"); 5031 return 3; 5032 } 5033 5034 # Connect to local peer -- although calling connect() for blocking unix 5035 # stream socket will usually return immediately, there are cases when 5036 # connect() might block (e.g., on Linux when server listen backlog is full). 5037 # For handling such cases, the socket will be switched to non-blocking 5038 # mode before calling connect(). If the connection to local peer is not 5039 # established immediately (EINPROGRESS on posix systems), buffer the data 5040 # for future transmission and return. Note that on Linux EINPROGRESS is 5041 # never returned for unix stream sockets, but rather EAGAIN which is never 5042 # returned on posix systems. Since EINTR error should not happen on posix 5043 # systems for non-blocking sockets, and on many platforms connect() should 5044 # not be called again after EINTR, there is no special handling for EINTR. 5045 5046 $handle->blocking(0); 5047 5048 if (!connect($handle, sockaddr_un($file))) { 5049 if ($! == EINPROGRESS || $! == EAGAIN) { 5050 $output_ustrconn{$file} = { "socket" => $handle, 5051 "buffer" => [ $event ], 5052 "time" => time() }; 5053 } else { 5054 log_msg(LOG_DEBUG, 5055 "Can't connect to socket '$file' for sending event '$event' ($!)"); 5056 } 5057 return 3; 5058 } 5059 5060 $output_ustream{$file} = $handle; 5061 5062 # transmit data to local peer (close the socket on hard send(2) error) 5063 5064 if (!send_to_socket($output_ustream{$file}, $event, "socket '$file'")) { 5065 delete $output_ustream{$file}; 5066 } 5067 5068 return 3; 5069} 5070 5071sub execute_closeustr_action { 5072 5073 my($actionlist, $text, $i) = @_; 5074 my($file); 5075 5076 $file = $actionlist->[$i+1]; 5077 substitute_actionlist_var($file, $text); 5078 5079 log_msg(LOG_DEBUG, "Closing unix stream socket '$file'"); 5080 5081 if (exists($output_ustream{$file})) { 5082 if (!close($output_ustream{$file})) { 5083 log_msg(LOG_WARN, "Error when closing socket '$file' ($!)"); 5084 } 5085 delete $output_ustream{$file}; 5086 } elsif (exists($output_ustrconn{$file})) { 5087 if (!close($output_ustrconn{$file}->{"socket"})) { 5088 log_msg(LOG_WARN, "Error when closing socket '$file' ($!)"); 5089 } 5090 delete $output_ustrconn{$file}; 5091 } else { 5092 log_msg(LOG_DEBUG, "Socket '$file' is not open, can't close"); 5093 } 5094 5095 return 2; 5096} 5097 5098sub execute_udpsock_action { 5099 5100 my($actionlist, $text, $i) = @_; 5101 my($peer, $event, $host, $port, $handle, $addr); 5102 5103 $peer = $actionlist->[$i+1]; 5104 $event = $actionlist->[$i+2]; 5105 5106 substitute_actionlist_var($peer, $text); 5107 substitute_actionlist_var($event, $text); 5108 5109 # apart from unexpected local system errors, communication errors with 5110 # remote peers are logged at the debug level, in order to prevent message 5111 # floods with higher severity when large amounts of data are transfered 5112 5113 log_msg(LOG_DEBUG, "Sending event '$event' to UDP peer '$peer'"); 5114 5115 # if the socket already exists, use it for transmitting data; if the 5116 # transmission fails with hard error from send(2) (e.g., server responded 5117 # with ICMP port unreachable to previous transmission which raises an error 5118 # condition for the socket), close the socket and attempt retransmission, 5119 # otherwise return immediately 5120 5121 if (exists($output_udpsock{$peer})) { 5122 5123 if (send_to_socket($output_udpsock{$peer}, $event, "UDP peer '$peer'")) { 5124 return 3; 5125 } 5126 5127 log_msg(LOG_DEBUG, "Retrying to send event '$event' to UDP peer '$peer'"); 5128 delete $output_udpsock{$peer}; 5129 } 5130 5131 # create the socket for communicating with remote peer 5132 5133 if ($peer !~ /^(.+):([0-9]+)$/) { 5134 log_msg(LOG_WARN, 5135 "Can't connect to UDP peer '$peer' for sending event '$event'", 5136 "(peer not in host:portnumber format)"); 5137 return 3; 5138 } 5139 5140 $host = $1; 5141 $port = $2; 5142 5143 ($handle, $addr) = create_sock_addr($host, $port, "udp"); 5144 5145 if (!defined($handle)) { 5146 log_msg(LOG_DEBUG, 5147 "Can't connect to UDP peer '$peer' for sending event '$event'"); 5148 return 3; 5149 } 5150 5151 # Connect to remote peer (connect() returns immediately for connectionless 5152 # sockets). Since EINTR error should not happen for connectionless sockets 5153 # on posix systems, and on many platforms connect() should not be called 5154 # again after EINTR, there is no special handling for EINTR. 5155 5156 if (!connect($handle, $addr)) { 5157 log_msg(LOG_DEBUG, 5158 "Can't connect to UDP peer '$peer' for sending event '$event' ($!)"); 5159 return 3; 5160 } 5161 5162 # switch the socket to non-blocking mode for all further communications 5163 5164 $handle->blocking(0); 5165 $output_udpsock{$peer} = $handle; 5166 5167 # transmit data to remote peer (close the socket on hard send(2) error) 5168 5169 if (!send_to_socket($output_udpsock{$peer}, $event, "UDP peer '$peer'")) { 5170 delete $output_udpsock{$peer}; 5171 } 5172 5173 return 3; 5174} 5175 5176sub execute_closeudp_action { 5177 5178 my($actionlist, $text, $i) = @_; 5179 my($peer); 5180 5181 $peer = $actionlist->[$i+1]; 5182 substitute_actionlist_var($peer, $text); 5183 5184 log_msg(LOG_DEBUG, "Closing socket for UDP peer '$peer'"); 5185 5186 if (exists($output_udpsock{$peer})) { 5187 if (!close($output_udpsock{$peer})) { 5188 log_msg(LOG_WARN, "Error when closing socket for UDP peer '$peer' ($!)"); 5189 } 5190 delete $output_udpsock{$peer}; 5191 } else { 5192 log_msg(LOG_DEBUG, "No socket for UDP peer '$peer', can't close"); 5193 } 5194 5195 return 2; 5196} 5197 5198sub execute_tcpsock_action { 5199 5200 my($actionlist, $text, $i) = @_; 5201 my($peer, $event, $host, $port, $handle, $addr); 5202 5203 $peer = $actionlist->[$i+1]; 5204 $event = $actionlist->[$i+2]; 5205 5206 substitute_actionlist_var($peer, $text); 5207 substitute_actionlist_var($event, $text); 5208 5209 # apart from unexpected local system errors, communication errors with 5210 # remote peers are logged at the debug level, in order to prevent message 5211 # floods with higher severity when large amounts of data are transfered 5212 5213 log_msg(LOG_DEBUG, "Sending event '$event' to TCP peer '$peer'"); 5214 5215 # If the socket exists and there is an established connection to remote 5216 # peer, send data to the peer. If sending failed with a hard error from 5217 # send(2), close the socket and attempt resending with a newly created 5218 # socket later in the function, otherwise return immediately. 5219 5220 if (exists($output_tcpsock{$peer})) { 5221 5222 if (send_to_socket($output_tcpsock{$peer}, $event, "TCP peer '$peer'")) { 5223 return 3; 5224 } 5225 5226 log_msg(LOG_DEBUG, "Retrying to send event '$event' to TCP peer '$peer'"); 5227 delete $output_tcpsock{$peer}; 5228 } 5229 5230 # the socket exists but the connection establishment is not complete 5231 5232 elsif (exists($output_tcpconn{$peer})) { 5233 5234 # buffer the event 5235 5236 push @{$output_tcpconn{$peer}->{"buffer"}}, $event; 5237 5238 # Check the status of the connection, and if the connection establishment 5239 # has completed, try to transmit all buffered events. If no hard send(2) 5240 # errors were encountered during transmission, regard the connection as 5241 # successfully established, and move the socket from %output_tcpconn hash 5242 # to %output_tcpsock hash. Otherwise, close the socket. 5243 5244 check_new_conn(\%output_tcpconn, \%output_tcpsock, $peer, "TCP peer"); 5245 5246 return 3; 5247 } 5248 5249 # If the socket did not exist previously or the established connection 5250 # was closed because of an error, recreate the socket and attempt to 5251 # establish a new connection for transmitting data to remote peer 5252 5253 if ($peer !~ /^(.+):([0-9]+)$/) { 5254 log_msg(LOG_WARN, 5255 "Can't connect to TCP peer '$peer' for sending event '$event'", 5256 "(peer not in host:portnumber format)"); 5257 return 3; 5258 } 5259 5260 $host = $1; 5261 $port = $2; 5262 5263 ($handle, $addr) = create_sock_addr($host, $port, "tcp"); 5264 5265 if (!defined($handle)) { 5266 log_msg(LOG_DEBUG, 5267 "Can't connect to TCP peer '$peer' for sending event '$event'"); 5268 return 3; 5269 } 5270 5271 # Connect to remote peer -- for avoiding blocking connect(), socket will be 5272 # switched to non-blocking mode before calling connect(). If the connection 5273 # to remote peer is not established immediately (EINPROGRESS), buffer the 5274 # data for future transmission and return. Since EINTR error should not 5275 # happen on posix systems for non-blocking sockets, and on many platforms 5276 # connect() should not be called again after EINTR, there is no special 5277 # handling for EINTR. 5278 5279 $handle->blocking(0); 5280 5281 if (!connect($handle, $addr)) { 5282 if ($! == EINPROGRESS) { 5283 $output_tcpconn{$peer} = { "socket" => $handle, 5284 "buffer" => [ $event ], 5285 "time" => time() }; 5286 } else { 5287 log_msg(LOG_DEBUG, 5288 "Can't connect to TCP peer '$peer' for sending event '$event' ($!)"); 5289 } 5290 return 3; 5291 } 5292 5293 $output_tcpsock{$peer} = $handle; 5294 5295 # transmit data to remote peer (close the socket on hard send(2) error) 5296 5297 if (!send_to_socket($output_tcpsock{$peer}, $event, "TCP peer '$peer'")) { 5298 delete $output_tcpsock{$peer}; 5299 } 5300 5301 return 3; 5302} 5303 5304sub execute_closetcp_action { 5305 5306 my($actionlist, $text, $i) = @_; 5307 my($peer); 5308 5309 $peer = $actionlist->[$i+1]; 5310 substitute_actionlist_var($peer, $text); 5311 5312 log_msg(LOG_DEBUG, "Closing socket for TCP peer '$peer'"); 5313 5314 if (exists($output_tcpsock{$peer})) { 5315 if (!close($output_tcpsock{$peer})) { 5316 log_msg(LOG_WARN, "Error when closing socket for TCP peer '$peer' ($!)"); 5317 } 5318 delete $output_tcpsock{$peer}; 5319 } elsif (exists($output_tcpconn{$peer})) { 5320 if (!close($output_tcpconn{$peer}->{"socket"})) { 5321 log_msg(LOG_WARN, "Error when closing socket for TCP peer '$peer' ($!)"); 5322 } 5323 delete $output_tcpconn{$peer}; 5324 } else { 5325 log_msg(LOG_DEBUG, "No socket for TCP peer '$peer', can't close"); 5326 } 5327 5328 return 2; 5329} 5330 5331sub execute_shellcmd_action { 5332 5333 my($actionlist, $text, $i) = @_; 5334 my($cmdline, $text2); 5335 5336 $cmdline = $actionlist->[$i+1]; 5337 $text2 = $text; 5338 5339 # if -quoting flag was specified, mask apostrophes in $text2 5340 # and put $text2 inside apostrophes 5341 5342 if ($quoting) { 5343 $text2 =~ s/'/'\\''/g; 5344 $text2 = "'" . $text2 . "'"; 5345 } 5346 5347 substitute_actionlist_var($cmdline, $text2); 5348 5349 log_msg(LOG_INFO, "Executing shell command '$cmdline'"); 5350 5351 exec_cmd($cmdline); 5352 5353 return 2; 5354} 5355 5356sub execute_cmdexec_action { 5357 5358 my($actionlist, $text, $i) = @_; 5359 my(@cmdline, $cmdline, $arg); 5360 5361 @cmdline = @{$actionlist->[$i+1]}; 5362 5363 foreach $arg (@cmdline) { substitute_actionlist_var($arg, $text); } 5364 5365 $cmdline = join(" ", @cmdline); 5366 5367 log_msg(LOG_INFO, "Executing command '$cmdline'"); 5368 5369 exec_cmd(\@cmdline); 5370 5371 return 2; 5372} 5373 5374sub execute_spawn_action { 5375 5376 my($actionlist, $text, $i) = @_; 5377 my($cmdline, $text2); 5378 5379 $cmdline = $actionlist->[$i+1]; 5380 $text2 = $text; 5381 5382 # if -quoting flag was specified, mask apostrophes in $text2 5383 # and put $text2 inside apostrophes 5384 5385 if ($quoting) { 5386 $text2 =~ s/'/'\\''/g; 5387 $text2 = "'" . $text2 . "'"; 5388 } 5389 5390 substitute_actionlist_var($cmdline, $text2); 5391 5392 log_msg(LOG_INFO, "Spawning shell command '$cmdline'"); 5393 5394 exec_cmd($cmdline, 1); 5395 5396 return 2; 5397} 5398 5399sub execute_spawnexec_action { 5400 5401 my($actionlist, $text, $i) = @_; 5402 my(@cmdline, $cmdline, $arg); 5403 5404 @cmdline = @{$actionlist->[$i+1]}; 5405 5406 foreach $arg (@cmdline) { substitute_actionlist_var($arg, $text); } 5407 5408 $cmdline = join(" ", @cmdline); 5409 5410 log_msg(LOG_INFO, "Spawning command '$cmdline'"); 5411 5412 exec_cmd(\@cmdline, 1); 5413 5414 return 2; 5415} 5416 5417sub execute_cspawn_action { 5418 5419 my($actionlist, $text, $i) = @_; 5420 my($context, $cmdline, $text2); 5421 5422 $context = $actionlist->[$i+1]; 5423 $cmdline = $actionlist->[$i+2]; 5424 $text2 = $text; 5425 5426 # if -quoting flag was specified, mask apostrophes in $text2 5427 # and put $text2 inside apostrophes 5428 5429 if ($quoting) { 5430 $text2 =~ s/'/'\\''/g; 5431 $text2 = "'" . $text2 . "'"; 5432 } 5433 5434 substitute_actionlist_var($context, $text2); 5435 substitute_actionlist_var($cmdline, $text2); 5436 5437 log_msg(LOG_INFO, 5438 "Spawning shell command '$cmdline' with context '$context'"); 5439 5440 exec_cmd($cmdline, 1, $context); 5441 5442 return 3; 5443} 5444 5445sub execute_cspawnexec_action { 5446 5447 my($actionlist, $text, $i) = @_; 5448 my(@cmdline, $cmdline, $context, $arg); 5449 5450 $context = $actionlist->[$i+1]; 5451 @cmdline = @{$actionlist->[$i+2]}; 5452 5453 substitute_actionlist_var($context, $text); 5454 5455 foreach $arg (@cmdline) { substitute_actionlist_var($arg, $text); } 5456 5457 $cmdline = join(" ", @cmdline); 5458 5459 log_msg(LOG_INFO, "Spawning command '$cmdline' with context '$context'"); 5460 5461 exec_cmd(\@cmdline, 1, $context); 5462 5463 return 3; 5464} 5465 5466sub execute_pipe_action { 5467 5468 my($actionlist, $text, $i) = @_; 5469 my($event, $cmdline); 5470 5471 $event = $actionlist->[$i+1]; 5472 $cmdline = $actionlist->[$i+2]; 5473 5474 substitute_actionlist_var($event, $text); 5475 substitute_actionlist_var($cmdline, $text); 5476 5477 log_msg(LOG_INFO, "Feeding event '$event' to shell command '$cmdline'"); 5478 5479 if (length($cmdline)) { 5480 pipe_cmd($cmdline, [ $event ]); 5481 } else { 5482 select(STDOUT); 5483 $| = 1; 5484 print STDOUT "$event\n"; 5485 } 5486 5487 return 3; 5488} 5489 5490sub execute_pipeexec_action { 5491 5492 my($actionlist, $text, $i) = @_; 5493 my(@cmdline, $cmdline, $event, $arg); 5494 5495 $event = $actionlist->[$i+1]; 5496 @cmdline = @{$actionlist->[$i+2]}; 5497 5498 substitute_actionlist_var($event, $text); 5499 5500 foreach $arg (@cmdline) { substitute_actionlist_var($arg, $text); } 5501 5502 $cmdline = join(" ", @cmdline); 5503 5504 log_msg(LOG_INFO, "Feeding event '$event' to command '$cmdline'"); 5505 5506 if (scalar(@cmdline)) { 5507 pipe_cmd(\@cmdline, [ $event ]); 5508 } else { 5509 select(STDOUT); 5510 $| = 1; 5511 print STDOUT "$event\n"; 5512 } 5513 5514 return 3; 5515} 5516 5517sub execute_create_action { 5518 5519 my($actionlist, $text, $i) = @_; 5520 my($context, $lifetime, $list); 5521 5522 $context = $actionlist->[$i+1]; 5523 $lifetime = $actionlist->[$i+2]; 5524 $list = $actionlist->[$i+3]; 5525 5526 substitute_actionlist_var($context, $text); 5527 substitute_actionlist_var($lifetime, $text); 5528 5529 log_msg(LOG_DEBUG, "Creating context '$context'"); 5530 5531 if ($lifetime =~ /^\s*0*([0-9]+)\s*$/) { 5532 5533 $lifetime = $1; 5534 5535 if (exists($context_list{$context})) { 5536 5537 if (!exists($context_list{$context}->{"Internal"})) { 5538 5539 $context_list{$context}->{"Time"} = time(); 5540 $context_list{$context}->{"Window"} = $lifetime; 5541 $context_list{$context}->{"Action"} = $list; 5542 $context_list{$context}->{"Desc"} = $text; 5543 @{$context_list{$context}->{"Buffer"}} = (); 5544 5545 } else { 5546 log_msg(LOG_WARN, 5547 "Invalid use of create action for internal context '$context'"); 5548 } 5549 5550 } else { 5551 5552 $context_list{$context} = { "Time" => time(), 5553 "Window" => $lifetime, 5554 "Buffer" => [], 5555 "Action" => $list, 5556 "Desc" => $text, 5557 "Aliases" => { $context => 1 } }; 5558 5559 } 5560 5561 } else { 5562 log_msg(LOG_WARN, 5563 "Invalid lifetime '$lifetime' for context '$context', can't create"); 5564 } 5565 5566 return 4; 5567} 5568 5569sub execute_delete_action { 5570 5571 my($actionlist, $text, $i) = @_; 5572 my($context, $alias); 5573 5574 $context = $actionlist->[$i+1]; 5575 substitute_actionlist_var($context, $text); 5576 5577 log_msg(LOG_DEBUG, "Deleting context '$context'"); 5578 5579 if (exists($context_list{$context}) && 5580 !exists($context_list{$context}->{"DeleteInProgress"})) { 5581 5582 if (!exists($context_list{$context}->{"Internal"})) { 5583 5584 foreach $alias (keys %{$context_list{$context}->{"Aliases"}}) { 5585 delete $context_list{$alias}; 5586 log_msg(LOG_DEBUG, "Context '$alias' deleted"); 5587 } 5588 5589 } else { 5590 log_msg(LOG_WARN, 5591 "Invalid use of delete action for internal context '$context'"); 5592 } 5593 5594 } else { 5595 log_msg(LOG_DEBUG, 5596 "Context '$context' does not exist or is already going through deletion"); 5597 } 5598 5599 return 2; 5600} 5601 5602sub execute_obsolete_action { 5603 5604 my($actionlist, $text, $i) = @_; 5605 my($context); 5606 5607 $context = $actionlist->[$i+1]; 5608 substitute_actionlist_var($context, $text); 5609 5610 log_msg(LOG_DEBUG, "Obsoleting context '$context'"); 5611 5612 if (exists($context_list{$context}) && 5613 !exists($context_list{$context}->{"DeleteInProgress"})) { 5614 5615 if (!exists($context_list{$context}->{"Internal"})) { 5616 $context_list{$context}->{"Window"} = -1; 5617 valid_context($context); 5618 } else { 5619 log_msg(LOG_WARN, 5620 "Invalid use of obsolete action for internal context '$context'"); 5621 } 5622 5623 } else { 5624 log_msg(LOG_DEBUG, 5625 "Context '$context' does not exist or is already going through deletion"); 5626 } 5627 5628 return 2; 5629} 5630 5631sub execute_set_action { 5632 5633 my($actionlist, $text, $i) = @_; 5634 my($context, $lifetime, $list); 5635 5636 $context = $actionlist->[$i+1]; 5637 $lifetime = $actionlist->[$i+2]; 5638 $list = $actionlist->[$i+3]; 5639 5640 substitute_actionlist_var($context, $text); 5641 substitute_actionlist_var($lifetime, $text); 5642 5643 log_msg(LOG_DEBUG, "Changing settings for context '$context'"); 5644 5645 if ($lifetime =~ /^\s*(?:0*([0-9]+)|-)\s*$/) { 5646 5647 $lifetime = $1; 5648 5649 if (exists($context_list{$context})) { 5650 5651 if (!exists($context_list{$context}->{"Internal"})) { 5652 5653 if (defined($lifetime)) { 5654 $context_list{$context}->{"Time"} = time(); 5655 $context_list{$context}->{"Window"} = $lifetime; 5656 } 5657 5658 if (scalar(@{$list})) { 5659 $context_list{$context}->{"Action"} = $list; 5660 $context_list{$context}->{"Desc"} = $text; 5661 } 5662 5663 } else { 5664 log_msg(LOG_WARN, 5665 "Invalid use of set action for internal context '$context'"); 5666 } 5667 5668 } else { 5669 log_msg(LOG_WARN, 5670 "Context '$context' does not exist, can't change settings"); 5671 } 5672 5673 } else { 5674 log_msg(LOG_WARN, 5675 "Invalid lifetime '$lifetime' for context '$context', can't change settings"); 5676 } 5677 5678 return 4; 5679} 5680 5681sub execute_alias_action { 5682 5683 my($actionlist, $text, $i) = @_; 5684 my($context, $alias); 5685 5686 $context = $actionlist->[$i+1]; 5687 $alias = $actionlist->[$i+2]; 5688 5689 substitute_actionlist_var($context, $text); 5690 substitute_actionlist_var($alias, $text); 5691 5692 log_msg(LOG_DEBUG, "Creating alias '$alias' for context '$context'"); 5693 5694 if (!exists($context_list{$context})) { 5695 log_msg(LOG_WARN, 5696 "Context '$context' does not exist, can't create alias"); 5697 } elsif (exists($context_list{$alias})) { 5698 log_msg(LOG_DEBUG, "Alias '$alias' already exists"); 5699 } elsif (!exists($context_list{$context}->{"Internal"})) { 5700 $context_list{$context}->{"Aliases"}->{$alias} = 1; 5701 $context_list{$alias} = $context_list{$context}; 5702 } else { 5703 log_msg(LOG_WARN, 5704 "Invalid use of alias action for internal context '$context'"); 5705 } 5706 5707 return 3; 5708} 5709 5710sub execute_unalias_action { 5711 5712 my($actionlist, $text, $i) = @_; 5713 my($alias); 5714 5715 $alias = $actionlist->[$i+1]; 5716 substitute_actionlist_var($alias, $text); 5717 5718 log_msg(LOG_DEBUG, "Removing alias '$alias'"); 5719 5720 if (exists($context_list{$alias}) && 5721 !exists($context_list{$alias}->{"DeleteInProgress"})) { 5722 5723 if (!exists($context_list{$alias}->{"Internal"})) { 5724 5725 delete $context_list{$alias}->{"Aliases"}->{$alias}; 5726 5727 if (!scalar(%{$context_list{$alias}->{"Aliases"}})) { 5728 log_msg(LOG_DEBUG, 5729 "Alias '$alias' was the last reference to a context"); 5730 } 5731 5732 delete $context_list{$alias}; 5733 5734 } else { 5735 log_msg(LOG_WARN, 5736 "Invalid use of unalias action for internal context '$alias'"); 5737 } 5738 5739 } else { 5740 log_msg(LOG_DEBUG, "Alias '$alias' does not exist or the referred context is already going through deletion"); 5741 } 5742 5743 return 2; 5744} 5745 5746sub execute_add_action { 5747 5748 my($actionlist, $text, $i) = @_; 5749 my($context, $event, @event); 5750 5751 $context = $actionlist->[$i+1]; 5752 $event = $actionlist->[$i+2]; 5753 5754 substitute_actionlist_var($context, $text); 5755 substitute_actionlist_var($event, $text); 5756 5757 log_msg(LOG_DEBUG, "Adding event(s) '$event' to context '$context'"); 5758 5759 if (!exists($context_list{$context})) { 5760 5761 $context_list{$context} = { "Time" => time(), 5762 "Window" => 0, 5763 "Buffer" => [], 5764 "Action" => [], 5765 "Desc" => "", 5766 "Aliases" => { $context => 1 } }; 5767 } 5768 5769 if (!exists($context_list{$context}->{"Internal"})) { 5770 5771 @event = split(/\n/, $event); # split returns empty list for "" or undef 5772 5773 if (!$evstoresize || scalar(@{$context_list{$context}->{"Buffer"}}) 5774 + scalar(@event) <= $evstoresize) { 5775 push @{$context_list{$context}->{"Buffer"}}, @event; 5776 } else { 5777 log_msg(LOG_WARN, 5778 "Can't add event(s) '$event' to context '$context', store full"); 5779 } 5780 5781 } else { 5782 log_msg(LOG_WARN, 5783 "Invalid use of add action for internal context '$context'"); 5784 } 5785 5786 return 3; 5787} 5788 5789sub execute_prepend_action { 5790 5791 my($actionlist, $text, $i) = @_; 5792 my($context, $event, @event); 5793 5794 $context = $actionlist->[$i+1]; 5795 $event = $actionlist->[$i+2]; 5796 5797 substitute_actionlist_var($context, $text); 5798 substitute_actionlist_var($event, $text); 5799 5800 log_msg(LOG_DEBUG, "Prepending event(s) '$event' to context '$context'"); 5801 5802 if (!exists($context_list{$context})) { 5803 5804 $context_list{$context} = { "Time" => time(), 5805 "Window" => 0, 5806 "Buffer" => [], 5807 "Action" => [], 5808 "Desc" => "", 5809 "Aliases" => { $context => 1 } }; 5810 } 5811 5812 if (!exists($context_list{$context}->{"Internal"})) { 5813 5814 @event = split(/\n/, $event); # split returns empty list for "" or undef 5815 5816 if (!$evstoresize || scalar(@{$context_list{$context}->{"Buffer"}}) 5817 + scalar(@event) <= $evstoresize) { 5818 unshift @{$context_list{$context}->{"Buffer"}}, @event; 5819 } else { 5820 log_msg(LOG_WARN, 5821 "Can't prepend event(s) '$event' to context '$context', store full"); 5822 } 5823 5824 } else { 5825 log_msg(LOG_WARN, 5826 "Invalid use of prepend action for internal context '$context'"); 5827 } 5828 5829 return 3; 5830} 5831 5832sub execute_fill_action { 5833 5834 my($actionlist, $text, $i) = @_; 5835 my($context, $event, @event); 5836 5837 $context = $actionlist->[$i+1]; 5838 $event = $actionlist->[$i+2]; 5839 5840 substitute_actionlist_var($context, $text); 5841 substitute_actionlist_var($event, $text); 5842 5843 log_msg(LOG_DEBUG, "Filling context '$context' with event(s) '$event'"); 5844 5845 if (!exists($context_list{$context})) { 5846 5847 $context_list{$context} = { "Time" => time(), 5848 "Window" => 0, 5849 "Buffer" => [], 5850 "Action" => [], 5851 "Desc" => "", 5852 "Aliases" => { $context => 1 } }; 5853 } 5854 5855 if (!exists($context_list{$context}->{"Internal"})) { 5856 5857 @event = split(/\n/, $event); # split returns empty list for "" or undef 5858 5859 if (!$evstoresize || scalar(@event) <= $evstoresize) { 5860 @{$context_list{$context}->{"Buffer"}} = @event; 5861 } else { 5862 log_msg(LOG_WARN, 5863 "Can't fill context '$context' with event(s) '$event', store full"); 5864 } 5865 5866 } else { 5867 log_msg(LOG_WARN, 5868 "Invalid use of fill action for internal context '$context'"); 5869 } 5870 5871 return 3; 5872} 5873 5874sub execute_report_action { 5875 5876 my($actionlist, $text, $i) = @_; 5877 my($context, $cmdline, $event); 5878 5879 $context = $actionlist->[$i+1]; 5880 $cmdline = $actionlist->[$i+2]; 5881 5882 substitute_actionlist_var($context, $text); 5883 substitute_actionlist_var($cmdline, $text); 5884 5885 log_msg(LOG_INFO, "Reporting the event store of context '$context' through shell command '$cmdline'"); 5886 5887 if (!exists($context_list{$context})) { 5888 log_msg(LOG_WARN, "Context '$context' does not exist, can't report"); 5889 } elsif (!scalar(@{$context_list{$context}->{"Buffer"}})) { 5890 log_msg(LOG_DEBUG, 5891 "Event store of context '$context' is empty, nothing to report"); 5892 } else { 5893 5894 if (length($cmdline)) { 5895 pipe_cmd($cmdline, $context_list{$context}->{"Buffer"}); 5896 } else { 5897 select(STDOUT); 5898 $| = 1; 5899 foreach $event (@{$context_list{$context}->{"Buffer"}}) { 5900 print STDOUT "$event\n"; 5901 } 5902 } 5903 5904 } 5905 5906 return 3; 5907} 5908 5909sub execute_reportexec_action { 5910 5911 my($actionlist, $text, $i) = @_; 5912 my(@cmdline, $cmdline, $context, $event, $arg); 5913 5914 $context = $actionlist->[$i+1]; 5915 @cmdline = @{$actionlist->[$i+2]}; 5916 5917 substitute_actionlist_var($context, $text); 5918 5919 foreach $arg (@cmdline) { substitute_actionlist_var($arg, $text); } 5920 5921 $cmdline = join(" ", @cmdline); 5922 5923 log_msg(LOG_INFO, "Reporting the event store of context '$context' through command '$cmdline'"); 5924 5925 if (!exists($context_list{$context})) { 5926 log_msg(LOG_WARN, "Context '$context' does not exist, can't report"); 5927 } elsif (!scalar(@{$context_list{$context}->{"Buffer"}})) { 5928 log_msg(LOG_DEBUG, 5929 "Event store of context '$context' is empty, nothing to report"); 5930 } else { 5931 5932 if (scalar(@cmdline)) { 5933 pipe_cmd(\@cmdline, $context_list{$context}->{"Buffer"}); 5934 } else { 5935 select(STDOUT); 5936 $| = 1; 5937 foreach $event (@{$context_list{$context}->{"Buffer"}}) { 5938 print STDOUT "$event\n"; 5939 } 5940 } 5941 5942 } 5943 5944 return 3; 5945} 5946 5947sub execute_copy_action { 5948 5949 my($actionlist, $text, $i) = @_; 5950 my($context, $variable, $value); 5951 5952 $context = $actionlist->[$i+1]; 5953 $variable = $actionlist->[$i+2]; 5954 5955 substitute_actionlist_var($context, $text); 5956 5957 log_msg(LOG_DEBUG, 5958 "Copying context '$context' to variable '%$variable'"); 5959 5960 if (exists($context_list{$context})) { 5961 5962 $value = join("\n", @{$context_list{$context}->{"Buffer"}}); 5963 $variables{$variable} = $value; 5964 log_msg(LOG_DEBUG, "Variable '%$variable' set to '$value'"); 5965 5966 } else { 5967 log_msg(LOG_WARN, "Context '$context' does not exist, can't copy"); 5968 } 5969 5970 return 3; 5971} 5972 5973sub execute_empty_action { 5974 5975 my($actionlist, $text, $i) = @_; 5976 my($context, $variable, $value); 5977 5978 $context = $actionlist->[$i+1]; 5979 $variable = $actionlist->[$i+2]; 5980 5981 substitute_actionlist_var($context, $text); 5982 5983 log_msg(LOG_DEBUG, "Emptying the event store of context '$context'"); 5984 5985 if (exists($context_list{$context})) { 5986 5987 if (length($variable)) { 5988 $value = join("\n", @{$context_list{$context}->{"Buffer"}}); 5989 $variables{$variable} = $value; 5990 log_msg(LOG_DEBUG, "Variable '%$variable' set to '$value'"); 5991 } 5992 5993 @{$context_list{$context}->{"Buffer"}} = (); 5994 5995 } else { 5996 log_msg(LOG_WARN, "Context '$context' does not exist, can't empty"); 5997 } 5998 5999 return 3; 6000} 6001 6002sub execute_pop_action { 6003 6004 my($actionlist, $text, $i) = @_; 6005 my($context, $variable, $value); 6006 6007 $context = $actionlist->[$i+1]; 6008 $variable = $actionlist->[$i+2]; 6009 6010 substitute_actionlist_var($context, $text); 6011 6012 log_msg(LOG_DEBUG, "Pop the last element of context '$context' event store into variable '%$variable'"); 6013 6014 if (exists($context_list{$context})) { 6015 6016 $value = pop @{$context_list{$context}->{"Buffer"}}; 6017 if (!defined($value)) { $value = ""; } 6018 $variables{$variable} = $value; 6019 log_msg(LOG_DEBUG, "Variable '%$variable' set to '$value'"); 6020 6021 } else { 6022 log_msg(LOG_WARN, "Context '$context' does not exist, can't pop"); 6023 } 6024 6025 return 3; 6026} 6027 6028sub execute_shift_action { 6029 6030 my($actionlist, $text, $i) = @_; 6031 my($context, $variable, $value); 6032 6033 $context = $actionlist->[$i+1]; 6034 $variable = $actionlist->[$i+2]; 6035 6036 substitute_actionlist_var($context, $text); 6037 6038 log_msg(LOG_DEBUG, "Shift the first element of context '$context' event store into variable '%$variable'"); 6039 6040 if (exists($context_list{$context})) { 6041 6042 $value = shift @{$context_list{$context}->{"Buffer"}}; 6043 if (!defined($value)) { $value = ""; } 6044 $variables{$variable} = $value; 6045 log_msg(LOG_DEBUG, "Variable '%$variable' set to '$value'"); 6046 6047 } else { 6048 log_msg(LOG_WARN, "Context '$context' does not exist, can't shift"); 6049 } 6050 6051 return 3; 6052} 6053 6054sub execute_exists_action { 6055 6056 my($actionlist, $text, $i) = @_; 6057 my($context, $variable, $value); 6058 6059 $variable = $actionlist->[$i+1]; 6060 $context = $actionlist->[$i+2]; 6061 6062 substitute_actionlist_var($context, $text); 6063 6064 log_msg(LOG_DEBUG, "Checking the presence of context '$context'"); 6065 6066 $value = (exists($context_list{$context}))?1:0; 6067 $variables{$variable} = $value; 6068 6069 log_msg(LOG_DEBUG, "Variable '%$variable' set to '$value'"); 6070 6071 return 3; 6072} 6073 6074sub execute_getsize_action { 6075 6076 my($actionlist, $text, $i) = @_; 6077 my($context, $variable, $value); 6078 6079 $variable = $actionlist->[$i+1]; 6080 $context = $actionlist->[$i+2]; 6081 6082 substitute_actionlist_var($context, $text); 6083 6084 log_msg(LOG_DEBUG, "Finding the size of context '$context' event store"); 6085 6086 if (exists($context_list{$context})) { 6087 $value = scalar(@{$context_list{$context}->{"Buffer"}}); 6088 $variables{$variable} = $value; 6089 log_msg(LOG_DEBUG, "Variable '%$variable' set to '$value'"); 6090 } else { 6091 $variables{$variable} = undef; 6092 log_msg(LOG_DEBUG, 6093 "Context '$context' does not exist, variable '%$variable' set to undef"); 6094 } 6095 6096 return 3; 6097} 6098 6099sub execute_getaliases_action { 6100 6101 my($actionlist, $text, $i) = @_; 6102 my($context, $variable, $value); 6103 6104 $variable = $actionlist->[$i+1]; 6105 $context = $actionlist->[$i+2]; 6106 6107 substitute_actionlist_var($context, $text); 6108 6109 log_msg(LOG_DEBUG, 6110 "Assigning aliases of context '$context' to variable '%$variable'"); 6111 6112 if (exists($context_list{$context})) { 6113 $value = join("\n", keys %{$context_list{$context}->{"Aliases"}}); 6114 $variables{$variable} = $value; 6115 log_msg(LOG_DEBUG, "Variable '%$variable' set to '$value'"); 6116 } else { 6117 log_msg(LOG_WARN, "Context '$context' does not exist, can't get aliases"); 6118 } 6119 6120 return 3; 6121} 6122 6123sub execute_getltime_action { 6124 6125 my($actionlist, $text, $i) = @_; 6126 my($context, $variable, $value); 6127 6128 $variable = $actionlist->[$i+1]; 6129 $context = $actionlist->[$i+2]; 6130 6131 substitute_actionlist_var($context, $text); 6132 6133 log_msg(LOG_DEBUG, 6134 "Assigning the lifetime of context '$context' to variable '%$variable'"); 6135 6136 if (exists($context_list{$context})) { 6137 $value = $context_list{$context}->{"Window"}; 6138 $variables{$variable} = $value; 6139 log_msg(LOG_DEBUG, "Variable '%$variable' set to '$value'"); 6140 } else { 6141 log_msg(LOG_WARN, "Context '$context' does not exist, can't get lifetime"); 6142 } 6143 6144 return 3; 6145} 6146 6147sub execute_setltime_action { 6148 6149 my($actionlist, $text, $i) = @_; 6150 my($context, $lifetime); 6151 6152 $context = $actionlist->[$i+1]; 6153 $lifetime = $actionlist->[$i+2]; 6154 6155 substitute_actionlist_var($context, $text); 6156 substitute_actionlist_var($lifetime, $text); 6157 6158 if ($lifetime =~ /^\s*0*([0-9]+)\s*$/) { 6159 6160 $lifetime = $1; 6161 6162 log_msg(LOG_DEBUG, 6163 "Setting the lifetime of context '$context' to '$lifetime'"); 6164 6165 if (exists($context_list{$context})) { 6166 6167 if (!exists($context_list{$context}->{"Internal"})) { 6168 6169 $context_list{$context}->{"Window"} = $lifetime; 6170 6171 if ($lifetime && 6172 time() - $context_list{$context}->{"Time"} > $lifetime) { 6173 6174 log_msg(LOG_DEBUG, 6175 "Context '$context' has become stale after lifetime adjustment"); 6176 6177 valid_context($context); 6178 } 6179 6180 } else { 6181 log_msg(LOG_WARN, 6182 "Invalid use of setltime action for internal context '$context'"); 6183 } 6184 6185 } else { 6186 log_msg(LOG_WARN, 6187 "Context '$context' does not exist, can't set lifetime"); 6188 } 6189 6190 } else { 6191 log_msg(LOG_WARN, "Invalid lifetime '$lifetime' for context '$context'"); 6192 } 6193 6194 return 3; 6195} 6196 6197sub execute_getctime_action { 6198 6199 my($actionlist, $text, $i) = @_; 6200 my($context, $variable, $value); 6201 6202 $variable = $actionlist->[$i+1]; 6203 $context = $actionlist->[$i+2]; 6204 6205 substitute_actionlist_var($context, $text); 6206 6207 log_msg(LOG_DEBUG, 6208 "Assigning the creation time of context '$context' to variable '%$variable'"); 6209 6210 if (exists($context_list{$context})) { 6211 $value = $context_list{$context}->{"Time"}; 6212 $variables{$variable} = $value; 6213 log_msg(LOG_DEBUG, "Variable '%$variable' set to '$value'"); 6214 } else { 6215 log_msg(LOG_WARN, 6216 "Context '$context' does not exist, can't get creation time"); 6217 } 6218 6219 return 3; 6220} 6221 6222sub execute_setctime_action { 6223 6224 my($actionlist, $text, $i) = @_; 6225 my($context, $timestamp); 6226 my($ltime, $time, $time2); 6227 6228 $timestamp = $actionlist->[$i+1]; 6229 $context = $actionlist->[$i+2]; 6230 6231 substitute_actionlist_var($timestamp, $text); 6232 substitute_actionlist_var($context, $text); 6233 6234 if ($timestamp =~ /^\s*0*([0-9]+)\s*$/) { 6235 6236 $timestamp = $1; 6237 $ltime = scalar(localtime($timestamp)); 6238 6239 log_msg(LOG_DEBUG, 6240 "Setting the creation time of context '$context' to '$ltime'"); 6241 6242 if (exists($context_list{$context})) { 6243 6244 if (!exists($context_list{$context}->{"Internal"})) { 6245 6246 $time = $context_list{$context}->{"Time"}; 6247 $time2 = time(); 6248 6249 if ($timestamp < $time) { 6250 log_msg(LOG_WARN, 6251 "Can't set context creation time backwards to '$ltime'"); 6252 } elsif ($timestamp > $time2) { 6253 log_msg(LOG_WARN, 6254 "Can't set context creation time into future to '$ltime'"); 6255 } elsif ($timestamp == $time) { 6256 log_msg(LOG_DEBUG, "Context creation time already set to '$ltime'"); 6257 } else { 6258 $context_list{$context}->{"Time"} = $timestamp; 6259 } 6260 6261 } else { 6262 log_msg(LOG_WARN, 6263 "Invalid use of setctime action for internal context '$context'"); 6264 } 6265 6266 } else { 6267 log_msg(LOG_WARN, 6268 "Context '$context' does not exist, can't set creation time"); 6269 } 6270 6271 } else { 6272 log_msg(LOG_WARN, 6273 "Invalid timestamp '$timestamp' for creation time of context '$context'"); 6274 } 6275 6276 return 3; 6277} 6278 6279sub execute_event_action { 6280 6281 my($actionlist, $text, $i) = @_; 6282 my($createafter, $event, @event); 6283 6284 $createafter = $actionlist->[$i+1]; 6285 $event = $actionlist->[$i+2]; 6286 6287 substitute_actionlist_var($event, $text); 6288 6289 @event = split(/\n/, $event); # split returns empty list for "" or undef 6290 6291 if ($createafter) { 6292 foreach $event (@event) { 6293 log_msg(LOG_DEBUG, "Scheduling the creation of event '$event' after $createafter seconds"); 6294 push @pending_events, [ time() + $createafter, $event, 6295 SYNEVENT_INT_CONTEXT ]; 6296 } 6297 } else { 6298 foreach $event (@event) { 6299 log_msg(LOG_DEBUG, "Creating event '$event'"); 6300 push @events, $event, SYNEVENT_INT_CONTEXT; 6301 } 6302 } 6303 6304 return 3; 6305} 6306 6307sub execute_tevent_action { 6308 6309 my($actionlist, $text, $i) = @_; 6310 my($createafter, $event, @event); 6311 6312 $createafter = $actionlist->[$i+1]; 6313 $event = $actionlist->[$i+2]; 6314 6315 substitute_actionlist_var($createafter, $text); 6316 substitute_actionlist_var($event, $text); 6317 6318 @event = split(/\n/, $event); # split returns empty list for "" or undef 6319 6320 if ($createafter =~ /^\s*0*([0-9]+)\s*$/) { 6321 6322 $createafter = $1; 6323 6324 if ($createafter) { 6325 foreach $event (@event) { 6326 log_msg(LOG_DEBUG, "Scheduling the creation of event '$event' after $createafter seconds"); 6327 push @pending_events, [ time() + $createafter, $event, 6328 SYNEVENT_INT_CONTEXT ]; 6329 } 6330 } else { 6331 foreach $event (@event) { 6332 log_msg(LOG_DEBUG, "Creating event '$event'"); 6333 push @events, $event, SYNEVENT_INT_CONTEXT; 6334 } 6335 } 6336 6337 } else { 6338 log_msg(LOG_WARN, 6339 "Invalid time specification '$createafter' for creating events"); 6340 } 6341 6342 return 3; 6343} 6344 6345sub execute_cevent_action { 6346 6347 my($actionlist, $text, $i) = @_; 6348 my($context, $createafter, $event, @event); 6349 6350 $context = $actionlist->[$i+1]; 6351 $createafter = $actionlist->[$i+2]; 6352 $event = $actionlist->[$i+3]; 6353 6354 substitute_actionlist_var($context, $text); 6355 substitute_actionlist_var($createafter, $text); 6356 substitute_actionlist_var($event, $text); 6357 6358 @event = split(/\n/, $event); # split returns empty list for "" or undef 6359 6360 if ($createafter =~ /^\s*0*([0-9]+)\s*$/) { 6361 6362 $createafter = $1; 6363 6364 if ($createafter) { 6365 foreach $event (@event) { 6366 log_msg(LOG_DEBUG, "Scheduling the creation of event '$event' with context '$context' after $createafter seconds"); 6367 push @pending_events, [ time() + $createafter, $event, $context ]; 6368 } 6369 } else { 6370 foreach $event (@event) { 6371 log_msg(LOG_DEBUG, "Creating event '$event' with context '$context'"); 6372 push @events, $event, $context; 6373 } 6374 } 6375 6376 } else { 6377 log_msg(LOG_WARN, 6378 "Invalid time specification '$createafter' for creating events"); 6379 } 6380 6381 return 4; 6382} 6383 6384sub execute_reset_action { 6385 6386 my($actionlist, $text, $i) = @_; 6387 my($conffile, $ruleid, $event); 6388 my($key, $rule); 6389 6390 $conffile = $actionlist->[$i+1]; 6391 $ruleid = $actionlist->[$i+2]; 6392 $event = $actionlist->[$i+3]; 6393 6394 substitute_actionlist_var($event, $text); 6395 6396 if (length($ruleid)) { 6397 6398 $key = gen_key($conffile, $ruleid, $event); 6399 6400 log_msg(LOG_DEBUG, "Terminating event correlation operation '$key'"); 6401 6402 $rule = $configuration{$conffile}->[$ruleid]; 6403 6404 if (exists($rule->{"Operations"})) { 6405 delete $rule->{"Operations"}->{$key}; 6406 } 6407 delete $corr_list{$key}; 6408 6409 } else { 6410 6411 log_msg(LOG_DEBUG, 6412 "Terminating all event correlation operations started from", 6413 $conffile, "with operation description string '$event'"); 6414 6415 foreach $rule (@{$configuration{$conffile}}) { 6416 6417 $key = gen_key($conffile, $rule->{"ID"}, $event); 6418 6419 if (exists($rule->{"Operations"})) { 6420 delete $rule->{"Operations"}->{$key}; 6421 } 6422 delete $corr_list{$key}; 6423 6424 } 6425 } 6426 6427 return 4; 6428} 6429 6430sub execute_getwpos_action { 6431 6432 my($actionlist, $text, $i) = @_; 6433 my($variable, $conffile, $ruleid, $event); 6434 my($key, $time); 6435 6436 $variable = $actionlist->[$i+1]; 6437 $conffile = $actionlist->[$i+2]; 6438 $ruleid = $actionlist->[$i+3]; 6439 $event = $actionlist->[$i+4]; 6440 6441 substitute_actionlist_var($event, $text); 6442 $key = gen_key($conffile, $ruleid, $event); 6443 6444 log_msg(LOG_DEBUG, 6445 "Getting event correlation window position for operation '$key'"); 6446 6447 if (exists($corr_list{$key})) { 6448 $time = $corr_list{$key}->{"Time"}; 6449 $variables{$variable} = $time; 6450 log_msg(LOG_DEBUG, "Variable '%$variable' set to '$time'"); 6451 } else { 6452 log_msg(LOG_WARN, 6453 "Operation '$key' does not exist, can't get window position"); 6454 } 6455 6456 return 5; 6457} 6458 6459sub execute_setwpos_action { 6460 6461 my($actionlist, $text, $i) = @_; 6462 my($timestamp, $conffile, $ruleid, $event); 6463 my($key, $oper, $ltime, $time, $time2); 6464 6465 $timestamp = $actionlist->[$i+1]; 6466 $conffile = $actionlist->[$i+2]; 6467 $ruleid = $actionlist->[$i+3]; 6468 $event = $actionlist->[$i+4]; 6469 6470 substitute_actionlist_var($timestamp, $text); 6471 substitute_actionlist_var($event, $text); 6472 6473 $key = gen_key($conffile, $ruleid, $event); 6474 6475 if ($timestamp !~ /^\s*0*([0-9]+)\s*$/) { 6476 log_msg(LOG_WARN, 6477 "Invalid timestamp '$timestamp' for moving the window of operation '$key'"); 6478 return 5; 6479 } 6480 6481 $timestamp = $1; 6482 $ltime = scalar(localtime($timestamp)); 6483 6484 log_msg(LOG_DEBUG, 6485 "Moving event correlation window to '$ltime' for operation '$key'"); 6486 6487 if (!exists($corr_list{$key})) { 6488 log_msg(LOG_WARN, 6489 "Operation '$key' does not exist, can't set window position"); 6490 return 5; 6491 } 6492 6493 $oper = $corr_list{$key}; 6494 $time = $oper->{"Time"}; 6495 $time2 = time(); 6496 6497 if (exists($oper->{"InitInProgress"})) { 6498 log_msg(LOG_WARN, 6499 "Operation '$key' is initializing, can't set window position"); 6500 return 5; 6501 } 6502 6503 if (exists($oper->{"DeleteInProgress"})) { 6504 log_msg(LOG_WARN, 6505 "Operation '$key' is terminating, can't set window position"); 6506 return 5; 6507 } 6508 6509 if ($timestamp < $time) { 6510 log_msg(LOG_WARN, 6511 "Can't move event correlation window backwards to '$ltime'"); 6512 return 5; 6513 } 6514 6515 if ($timestamp > $time2) { 6516 log_msg(LOG_WARN, 6517 "Can't move event correlation window into future to '$ltime'"); 6518 return 5; 6519 } 6520 6521 if ($timestamp == $time) { 6522 log_msg(LOG_DEBUG, 6523 "Event correlation window is already positioned at '$ltime'"); 6524 return 5; 6525 } 6526 6527 if ($oper->{"Type"} == SINGLE_W_THRESHOLD) { 6528 6529 if (!exists($oper->{"SuppressMode"})) { 6530 update_times_swt($oper, $timestamp, 1); 6531 if (!scalar(@{$oper->{"Times"}})) { delete $corr_list{$key}; } 6532 } else { 6533 $oper->{"Time"} = $timestamp; 6534 } 6535 6536 } elsif ($oper->{"Type"} == SINGLE_W_2_THRESHOLDS) { 6537 6538 if (!exists($oper->{"2ndPass"})) { 6539 update_times_swt($oper, $timestamp, 1); 6540 if (!scalar(@{$oper->{"Times"}})) { delete $corr_list{$key}; } 6541 } else { 6542 update_times_swt($oper, $timestamp, 1); 6543 } 6544 6545 } elsif ($oper->{"Type"} == EVENT_GROUP) { 6546 6547 if (!exists($oper->{"SuppressMode"})) { 6548 update_times_eg($oper, $timestamp, 1); 6549 if (!scalar(@{$oper->{"AllTimes"}})) { 6550 $oper->{"DeleteInProgress"} = 1; 6551 execute_actionlist($oper->{"EndAction"}, $oper->{"Desc"}); 6552 delete $corr_list{$key}; 6553 } 6554 } else { 6555 $oper->{"Time"} = $timestamp; 6556 } 6557 6558 } else { $oper->{"Time"} = $timestamp; } 6559 6560 if (!exists($corr_list{$key})) { 6561 log_msg(LOG_DEBUG, 6562 "Operation '$key' finished its work after window was moved"); 6563 } 6564 6565 return 5; 6566} 6567 6568sub execute_assign_action { 6569 6570 my($actionlist, $text, $i) = @_; 6571 my($variable, $value); 6572 6573 $variable = $actionlist->[$i+1]; 6574 $value = $actionlist->[$i+2]; 6575 6576 substitute_actionlist_var($value, $text); 6577 6578 log_msg(LOG_DEBUG, "Assigning '$value' to variable '%$variable'"); 6579 6580 $variables{$variable} = $value; 6581 6582 return 3; 6583} 6584 6585sub execute_assignsq_action { 6586 6587 my($actionlist, $text, $i) = @_; 6588 my($variable, $value); 6589 6590 $variable = $actionlist->[$i+1]; 6591 $value = $actionlist->[$i+2]; 6592 6593 substitute_actionlist_var($value, $text); 6594 6595 $value =~ s/'/'\\''/g; 6596 $value = "'" . $value . "'"; 6597 6598 log_msg(LOG_DEBUG, "Assigning '$value' to variable '%$variable'"); 6599 6600 $variables{$variable} = $value; 6601 6602 return 3; 6603} 6604 6605sub execute_free_action { 6606 6607 my($actionlist, undef, $i) = @_; 6608 my($variable); 6609 6610 $variable = $actionlist->[$i+1]; 6611 6612 log_msg(LOG_DEBUG, "Freeing variable '%$variable'"); 6613 6614 delete $variables{$variable}; 6615 6616 return 2; 6617} 6618 6619sub execute_eval_action { 6620 6621 my($actionlist, $text, $i) = @_; 6622 my($variable, $code); 6623 my(@retval, $evalok, $value); 6624 6625 $variable = $actionlist->[$i+1]; 6626 $code = $actionlist->[$i+2]; 6627 6628 substitute_actionlist_var($code, $text); 6629 6630 log_msg(LOG_DEBUG, 6631 "Evaluating code '$code' and setting variable '%$variable'"); 6632 6633 @retval = SEC::call_eval($code, 1); 6634 $evalok = shift @retval; 6635 6636 if ($evalok) { 6637 6638 foreach $value (@retval) { if (!defined($value)) { $value = ""; } } 6639 6640 if (scalar(@retval) > 1) { 6641 $value = join("\n", @retval); 6642 $variables{$variable} = $value; 6643 log_msg(LOG_DEBUG, "Variable '%$variable' set to '$value'"); 6644 } elsif (scalar(@retval) == 1) { 6645 # this check is needed for cases when 'eval' returns a code reference, 6646 # because join() converts it to a string and 'call' actions will fail 6647 $variables{$variable} = $retval[0]; 6648 log_msg(LOG_DEBUG, "Variable '%$variable' set to '$retval[0]'"); 6649 } else { 6650 $variables{$variable} = undef; 6651 log_msg(LOG_DEBUG, 6652 "No value received for variable '%$variable', set to undef"); 6653 } 6654 6655 } else { 6656 log_msg(LOG_ERR, "Error evaluating code '$code':", $retval[0]); 6657 } 6658 6659 return 3; 6660} 6661 6662sub execute_call_action { 6663 6664 my($actionlist, $text, $i) = @_; 6665 my($variable, $code, @params); 6666 my($value, @retval); 6667 6668 $variable = $actionlist->[$i+1]; 6669 $code = $actionlist->[$i+2]; 6670 @params = @{$actionlist->[$i+3]}; 6671 6672 log_msg(LOG_DEBUG, 6673 "Calling code '%$code->()' and setting variable '%$variable'"); 6674 6675 if (ref($variables{$code}) eq "CODE") { 6676 6677 foreach $value (@params) { substitute_actionlist_var($value, $text); } 6678 @retval = eval { $variables{$code}->(@params) }; 6679 6680 if ($@) { 6681 log_msg(LOG_ERR, "Code '%$code->()' runtime error:", $@); 6682 } else { 6683 6684 if (scalar(@retval)) { 6685 foreach $value (@retval) { if (!defined($value)) { $value = ""; } } 6686 $value = join("\n", @retval); 6687 $variables{$variable} = $value; 6688 log_msg(LOG_DEBUG, "Variable '%$variable' set to '$value'"); 6689 } else { 6690 $variables{$variable} = undef; 6691 log_msg(LOG_DEBUG, 6692 "No value received for variable '%$variable', set to undef"); 6693 } 6694 6695 } 6696 6697 } else { 6698 log_msg(LOG_WARN, "Variable '%$code' is not a code reference"); 6699 } 6700 6701 return 4; 6702} 6703 6704sub execute_lcall_action { 6705 6706 my($actionlist, $text, $i) = @_; 6707 my($variable, $codeptr, $op, @params); 6708 my($value, @retval); 6709 6710 $variable = $actionlist->[$i+1]; 6711 $codeptr = $actionlist->[$i+2]; 6712 @params = @{$actionlist->[$i+3]}; 6713 $op = $actionlist->[$i+4]; 6714 6715 log_msg(LOG_DEBUG, 6716 "Calling code '$codeptr' and setting variable '%$variable'"); 6717 6718 foreach $value (@params) { substitute_actionlist_var($value, $text); } 6719 6720 if ($op) { 6721 foreach $value (@params) { 6722 $value = exists($pmatch_cache{$value})?$pmatch_cache{$value}:undef; 6723 } 6724 } 6725 6726 @retval = eval { $codeptr->(@params) }; 6727 6728 if ($@) { 6729 log_msg(LOG_ERR, "Code '$codeptr' runtime error:", $@); 6730 } else { 6731 6732 if (scalar(@retval)) { 6733 foreach $value (@retval) { if (!defined($value)) { $value = ""; } } 6734 $value = join("\n", @retval); 6735 $variables{$variable} = $value; 6736 log_msg(LOG_DEBUG, "Variable '%$variable' set to '$value'"); 6737 } else { 6738 $variables{$variable} = undef; 6739 log_msg(LOG_DEBUG, 6740 "No value received for variable '%$variable', set to undef"); 6741 } 6742 6743 } 6744 6745 return 5; 6746} 6747 6748sub execute_rewrite_action { 6749 6750 my($actionlist, $text, $i) = @_; 6751 my($count, $event, @event, $j, $buffer, $bufptr); 6752 6753 $count = $actionlist->[$i+1]; 6754 $event = $actionlist->[$i+2]; 6755 6756 substitute_actionlist_var($count, $text); 6757 substitute_actionlist_var($event, $text); 6758 6759 if ($count =~ /^\s*0*([0-9]+)\s*$/) { 6760 6761 $count = $1; 6762 6763 @event = split(/\n/, $event); # split returns empty list for "" or undef 6764 $j = scalar(@event); 6765 6766 if (!$count) { 6767 if (!$j) { 6768 log_msg(LOG_WARN, "No data for rewriting input buffer"); 6769 return 3; 6770 } else { $count = $j; } 6771 } 6772 6773 if ($count > $bufsize) { $count = $bufsize; } 6774 6775 if ($j > $count) { 6776 @event = @event[0 .. $count - 1]; 6777 $event = join("\n", @event); 6778 } elsif ($j < $count) { 6779 while ($j++ < $count) { unshift @event, ""; } 6780 $event = join("\n", @event); 6781 } 6782 6783 if ($jointbuf) { 6784 6785 @input_buffer[$bufpos - $count + 1 .. $bufpos] = @event; 6786 log_msg(LOG_DEBUG, "Input buffer rewritten with '$event'"); 6787 6788 } elsif (defined($input_sources[$bufpos])) { 6789 6790 # if the 'rewrite' action is not triggered by a pattern match but 6791 # rather by system clock, the source for last input line might be 6792 # no longer monitored (also, the elements of @input_sources list 6793 # are set to "" at program startup) 6794 6795 if (exists($input_buffers{$input_sources[$bufpos]})) { 6796 $buffer = $input_buffers{$input_sources[$bufpos]}->{"Events"}; 6797 $bufptr = $input_buffers{$input_sources[$bufpos]}->{"BufPos"}; 6798 @{$buffer}[$bufptr - $count + 1 .. $bufptr] = @event; 6799 log_msg(LOG_DEBUG, "Input buffer of", $input_sources[$bufpos], 6800 "rewritten with '$event'"); 6801 } else { 6802 log_msg(LOG_WARN, 6803 "Can't rewrite the input buffer of non-configured source", 6804 $input_sources[$bufpos]); 6805 } 6806 6807 } else { 6808 6809 $buffer = $event_buffer{"Events"}; 6810 $bufptr = $event_buffer{"BufPos"}; 6811 @{$buffer}[$bufptr - $count + 1 .. $bufptr] = @event; 6812 log_msg(LOG_DEBUG, 6813 "Input buffer of synthetic events rewritten with '$event'"); 6814 } 6815 6816 } else { 6817 log_msg(LOG_WARN, "Invalid linecount '$count', can't rewrite input buffer"); 6818 } 6819 6820 return 3; 6821} 6822 6823sub execute_addinput_action { 6824 6825 my($actionlist, $text, $i) = @_; 6826 my($file, $fpos, $context); 6827 my($time, $fh, $dev, $inode, $regfile); 6828 6829 $file = $actionlist->[$i+1]; 6830 $fpos = $actionlist->[$i+2]; 6831 $context = $actionlist->[$i+3]; 6832 6833 substitute_actionlist_var($file, $text); 6834 substitute_actionlist_var($fpos, $text); 6835 substitute_actionlist_var($context, $text); 6836 6837 log_msg(LOG_DEBUG, "Adding dynamic input file '" . $file . 6838 "' with context '" . $context . "' to the list of inputs"); 6839 6840 if (exists($dyninputfiles{$file})) { 6841 log_msg(LOG_WARN, "Dynamic input file '" . $file . 6842 "' already exists in the list of inputs, can't add"); 6843 return 4; 6844 } 6845 6846 if (exists($inputsrc{$file})) { 6847 log_msg(LOG_WARN, "Input file '" . $file . 6848 "' already exists in the list of inputs, can't add"); 6849 return 4; 6850 } 6851 6852 if ($fpos !~ /^\s*(-|[0-9]+)\s*$/i) { 6853 log_msg(LOG_WARN, 6854 "Invalid file offset '$fpos' specified for input file '$file'"); 6855 return 4; 6856 } 6857 6858 $fpos = $1; 6859 6860 # open dynamic input file 6861 6862 if ($fpos eq "-") { 6863 $fpos = -1; 6864 log_msg(LOG_DEBUG, "Opening input file '$file' and seeking EOF"); 6865 } else { 6866 log_msg(LOG_DEBUG, "Opening input file '$file' and seeking offset '$fpos'"); 6867 } 6868 6869 ($fh, $dev, $inode, $regfile) = open_input_file($file, $fpos); 6870 6871 $time = time(); 6872 6873 $inputsrc{$file} = { "fh" => $fh, 6874 "open" => defined($fh), 6875 "dev" => $dev, 6876 "inode" => $inode, 6877 "regfile" => $regfile, 6878 "buffer" => "", 6879 "scriptexec" => 0, 6880 "checktime" => 0, 6881 "lastopen" => $time, 6882 "lastread" => $time, 6883 "lines" => 0, 6884 "context" => $context }; 6885 6886 # if the input file open failed because of the missing file, set the 6887 # "read_from_start" flag which enforces reading from the beginning 6888 # when the file will appear and another open will be attempted 6889 6890 if (!defined($fh) && $file ne "-" && ! -e $file) { 6891 $inputsrc{$file}->{"read_from_start"} = 1; 6892 } 6893 6894 # add dynamic input file to %dyninputfiles and @inputfiles global lists 6895 6896 $dyninputfiles{$file} = $context; 6897 6898 @inputfiles = sort keys %inputsrc; 6899 6900 # with --nojointbuf command line option, set up a separate 6901 # input buffer for the dynamic input file 6902 6903 if (!$jointbuf) { 6904 6905 $input_buffers{$file} = {}; 6906 $input_buffers{$file}->{"Events"} = []; 6907 $input_buffers{$file}->{"BufPos"} = 0; 6908 6909 $input_buffers{$file}->{"BufPos"} = 6910 arrange_input_buffer($input_buffers{$file}->{"Events"}, 6911 $input_buffers{$file}->{"BufPos"}); 6912 } 6913 6914 return 4; 6915} 6916 6917sub execute_dropinput_action { 6918 6919 my($actionlist, $text, $i) = @_; 6920 my(@buf, $file, $j, $n); 6921 6922 $file = $actionlist->[$i+1]; 6923 6924 substitute_actionlist_var($file, $text); 6925 6926 log_msg(LOG_DEBUG, 6927 "Dropping dynamic input file '$file' from the list of inputs"); 6928 6929 if (exists($dyninputfiles{$file})) { 6930 6931 # Drop dynamic input file from %dyninputfiles, %inputsrc and @inputfiles 6932 # global lists. Note that removing relevant entry from %inputsrc will 6933 # close the file (if it is open). 6934 6935 delete $dyninputfiles{$file}; 6936 6937 delete $inputsrc{$file}; 6938 6939 @inputfiles = sort keys %inputsrc; 6940 6941 # with --nojointbuf command line option, drop a separate 6942 # input buffer of the dynamic input file 6943 6944 if (!$jointbuf) { delete $input_buffers{$file}; } 6945 6946 # remove all lines for dynamic input file from read buffer 6947 6948 @buf = (); 6949 $n = scalar(@readbuffer); 6950 6951 for ($j = 0; $j < $n; $j += 2) { 6952 if ($file eq $readbuffer[$j+1]) { next; } 6953 push @buf, $readbuffer[$j], $readbuffer[$j+1]; 6954 } 6955 6956 @readbuffer = @buf; 6957 6958 } else { 6959 log_msg(LOG_WARN, "Dynamic input file '$file' not found, can't drop"); 6960 } 6961 6962 return 2; 6963} 6964 6965sub execute_sigemul_action { 6966 6967 my($actionlist, $text, $i) = @_; 6968 my($signal); 6969 6970 $signal = $actionlist->[$i+1]; 6971 6972 substitute_actionlist_var($signal, $text); 6973 6974 $signal = uc($signal); 6975 6976 log_msg(LOG_DEBUG, "Emulating the arrival of '$signal' signal"); 6977 6978 if ($signal eq "HUP") { 6979 $refresh = 1; 6980 $sigreceived = 1; 6981 } elsif ($signal eq "ABRT") { 6982 $softrefresh = 1; 6983 $sigreceived = 1; 6984 } elsif ($signal eq "USR1") { 6985 $dumpdata = 1; 6986 $sigreceived = 1; 6987 } elsif ($signal eq "USR2") { 6988 $openlog = 1; 6989 $sigreceived = 1; 6990 } elsif ($signal eq "INT") { 6991 ++$debuglevelinc; 6992 $sigreceived = 1; 6993 } elsif ($signal eq "TERM") { 6994 $terminate{$$} = 1; 6995 $sigreceived = 1; 6996 } else { 6997 log_msg(LOG_WARN, "The arrival of '$signal' signal can't be emulated"); 6998 } 6999 7000 return 2; 7001} 7002 7003sub execute_varset_action { 7004 7005 my($actionlist, $text, $i) = @_; 7006 my($entry, $variable, $value); 7007 7008 $variable = $actionlist->[$i+1]; 7009 $entry = $actionlist->[$i+2]; 7010 7011 substitute_actionlist_var($entry, $text); 7012 7013 log_msg(LOG_DEBUG, 7014 "Checking the presence of pattern match cache entry '$entry'"); 7015 7016 $value = (exists($pmatch_cache{$entry}))?1:0; 7017 $variables{$variable} = $value; 7018 7019 log_msg(LOG_DEBUG, "Variable '%$variable' set to '$value'"); 7020 7021 return 3; 7022} 7023 7024sub execute_if_action { 7025 7026 my($actionlist, $text, $i) = @_; 7027 my($variable, $ret); 7028 7029 $variable = $actionlist->[$i+1]; 7030 $ret = 1; 7031 7032 if (exists($variables{$variable}) && $variables{$variable}) { 7033 if (scalar(@{$actionlist->[$i+2]})) { 7034 $ret = execute_actionlist($actionlist->[$i+2], $text); 7035 } 7036 } else { 7037 if (scalar(@{$actionlist->[$i+3]})) { 7038 $ret = execute_actionlist($actionlist->[$i+3], $text); 7039 } 7040 } 7041 7042 if ($ret != 1) { return $ret; } 7043 7044 return 4; 7045} 7046 7047sub execute_while_action { 7048 7049 my($actionlist, $text, $i) = @_; 7050 my($variable); 7051 7052 $variable = $actionlist->[$i+1]; 7053 7054 while (exists($variables{$variable}) && $variables{$variable}) { 7055 if (execute_actionlist($actionlist->[$i+2], $text) == -1) { last; } 7056 } 7057 7058 return 3; 7059} 7060 7061sub execute_break_action { return -1; } 7062 7063sub execute_continue_action { return 0; } 7064 7065 7066# Parameters: par1 - reference to a list of actions 7067# par2 - event description text 7068# Action: execute actions in a given action list. 7069# Return 1 if the action list was fully executed; 7070# return 0 if the execution was interrupted with the continue action; 7071# return -1 if the execution was interrupted with the break action. 7072 7073sub execute_actionlist { 7074 7075 my($actionlist, $text) = @_; 7076 my($i, $j, $k); 7077 7078 $i = 0; 7079 $j = scalar(@{$actionlist}); 7080 7081 while ($i < $j) { 7082 $k = $execactionfunc[$actionlist->[$i]]->($actionlist, $text, $i); 7083 if ($k <= 0) { return $k; } 7084 $i += $k; 7085 } 7086 7087 return 1; 7088} 7089 7090 7091##################################################### 7092# Functions related to processing of lists at runtime 7093##################################################### 7094 7095 7096# Parameters: par1 - context 7097# Action: check if context "par1" is valid at the moment and return 1 7098# if it is, otherwise return 0. If context "par1" is found to 7099# be stale but is still present in the context list, it will be 7100# removed from there, and if it has an action list, the action 7101# list will be executed. 7102 7103sub valid_context { 7104 7105 my($context) = $_[0]; 7106 my($ref, $alias); 7107 7108 if (exists($context_list{$context})) { 7109 7110 # if the context has infinite lifetime or if its lifetime is not 7111 # exceeded, it is valid (TRUE) and return 1 7112 7113 if (!$context_list{$context}->{"Window"}) { return 1; } 7114 7115 if (time() - $context_list{$context}->{"Time"} 7116 <= $context_list{$context}->{"Window"}) { return 1; } 7117 7118 # if the valid_context was called recursively and action-list-on-expire 7119 # is currently executing, the context is considered stale and return 0 7120 7121 if (exists($context_list{$context}->{"DeleteInProgress"})) { return 0; } 7122 7123 log_msg(LOG_DEBUG, "Deleting stale context '$context'"); 7124 7125 # if the context is stale and its action-list-on-expire has not been 7126 # executed yet, execute it now 7127 7128 if (scalar(@{$context_list{$context}->{"Action"}})) { 7129 7130 # DeleteInProgress flag indicates that the action list execution is 7131 # in progress. The flag is used for two purposes: 7132 # 1) if this function is called recursively for the context, the flag 7133 # prevents the action-list-on-expire from being executed again, 7134 # 2) the flag will temporarily disable all actions that remove either 7135 # the context or any of its names (delete, obsolete, unalias) until 7136 # the action-list-on-expire has completed 7137 7138 $context_list{$context}->{"DeleteInProgress"} = 1; 7139 7140 # if context name _THIS exists, the action list execution was triggered 7141 # by the action-list-on-expire of another context that is currently 7142 # referred by _THIS, therefore save the current value of _THIS 7143 7144 if (exists($context_list{"_THIS"})) { $ref = $context_list{"_THIS"}; } 7145 else { $ref = undef; } 7146 7147 # set _THIS to refer to the current context 7148 7149 $context_list{"_THIS"} = $context_list{$context}; 7150 7151 # execute the action-list-on-expire 7152 7153 execute_actionlist($context_list{$context}->{"Action"}, 7154 $context_list{$context}->{"Desc"}); 7155 7156 # if context name _THIS was referring to another context previously, 7157 # restore the previous value, otherwise delete _THIS 7158 7159 if (defined($ref)) { $context_list{"_THIS"} = $ref; } 7160 else { delete $context_list{"_THIS"}; } 7161 7162 } 7163 7164 # remove all names of the context from the list of contexts 7165 7166 foreach $alias (keys %{$context_list{$context}->{"Aliases"}}) { 7167 delete $context_list{$alias}; 7168 log_msg(LOG_DEBUG, "Stale context '$alias' deleted"); 7169 } 7170 7171 } 7172 7173 return 0; 7174 7175} 7176 7177 7178# Parameters: par1 - reference to a context expression 7179# Action: calculate the truth value of the context expression par1; 7180# return 1 if it is TRUE, 0 if it is FALSE, and undef if 7181# the context expression is empty. 7182 7183sub tval_context_expr { 7184 7185 my($ref) = $_[0]; 7186 my($i, $j, $left, @right); 7187 my($evalresult, $evalok, $retval); 7188 my($code, $func, $param, @params); 7189 7190 $i = 0; 7191 $j = scalar(@{$ref}); 7192 $left = undef; 7193 @right = (); 7194 7195 while ($i < $j) { 7196 7197 if ($ref->[$i] == OPERAND) { 7198 7199 if (defined($left)) { 7200 push @right, OPERAND, $ref->[$i+1]; 7201 } else { 7202 $left = valid_context($ref->[$i+1]); 7203 } 7204 7205 $i += 2; 7206 7207 } 7208 7209 elsif ($ref->[$i] == NEGATION) { 7210 7211 # if the second operand is present, negation belongs to it, 7212 # otherwise negate the value of the first operand 7213 7214 if (scalar(@right)) { 7215 push @right, NEGATION; 7216 } else { 7217 $left = $left?0:1; 7218 } 7219 7220 ++$i; 7221 7222 } 7223 7224 elsif ($ref->[$i] == AND) { 7225 7226 # the && operator has the short-circuiting capability and returns 7227 # the value of the last evaluated operand which is either 0 or 1 7228 7229 $left = $left && tval_context_expr(\@right); 7230 @right = (); 7231 7232 ++$i; 7233 7234 } 7235 7236 elsif ($ref->[$i] == OR) { 7237 7238 # the || operator has the short-circuiting capability and returns 7239 # the value of the last evaluated operand which is either 0 or 1 7240 7241 $left = $left || tval_context_expr(\@right); 7242 @right = (); 7243 7244 ++$i; 7245 7246 } 7247 7248 elsif ($ref->[$i] == EXPRESSION) { 7249 7250 if (defined($left)) { 7251 push @right, EXPRESSION, $ref->[$i+1]; 7252 } else { 7253 $left = tval_context_expr($ref->[$i+1]); 7254 } 7255 7256 $i += 2; 7257 7258 } 7259 7260 elsif ($ref->[$i] == ECODE) { 7261 7262 if (defined($left)) { 7263 7264 push @right, ECODE, $ref->[$i+1]; 7265 7266 } else { 7267 7268 # if eval() for $code failed or returned false in boolean context 7269 # (undef, "", or 0), set $left to 0, otherwise set $left to 1 7270 7271 $code = $ref->[$i+1]; 7272 ($evalok, $evalresult) = SEC::call_eval($code, 0); 7273 7274 if (!$evalok) { 7275 log_msg(LOG_ERR, "Error evaluating code '$code': $evalresult"); 7276 $left = 0; 7277 } else { 7278 $left = $evalresult?1:0; 7279 } 7280 7281 } 7282 7283 $i += 2; 7284 7285 } 7286 7287 elsif ($ref->[$i] == CCODE) { 7288 7289 if (defined($left)) { 7290 7291 push @right, CCODE, $ref->[$i+1], $ref->[$i+2]; 7292 7293 } else { 7294 7295 # parameters for $func->() are copied into a new list @params, since 7296 # tval_context_expr() function could be called for the original 7297 # context expression definition (e.g., if the rule type is Calendar 7298 # or if the context expression is in []-brackets). Thus, passing 7299 # original parameter list to the end user would allow the user to 7300 # modify the original context definition. Furthermore, varset 7301 # parameters need to be replaced with corresponding references. 7302 7303 @params = @{$ref->[$i+1]}; 7304 $func = $ref->[$i+2]; 7305 7306 $retval = eval { $func->(@params) }; 7307 7308 # if function call failed or returned false in boolean context 7309 # (undef, "", or 0), set $left to 0, otherwise set $left to 1 7310 7311 if ($@) { 7312 log_msg(LOG_ERR, "Context expression runtime error:", $@); 7313 $left = 0; 7314 } else { 7315 $left = $retval?1:0; 7316 } 7317 7318 } 7319 7320 $i += 3; 7321 7322 } 7323 7324 elsif ($ref->[$i] == CCODE2) { 7325 7326 if (defined($left)) { 7327 7328 push @right, CCODE2, $ref->[$i+1], $ref->[$i+2]; 7329 7330 } else { 7331 7332 # parameters for $func->() are copied into a new list @params, since 7333 # tval_context_expr() function could be called for the original 7334 # context expression definition (e.g., if the rule type is Calendar 7335 # or if the context expression is in []-brackets). Thus, passing 7336 # original parameter list to the end user would allow the user to 7337 # modify the original context definition. Furthermore, varset 7338 # parameters need to be replaced with corresponding references. 7339 7340 @params = @{$ref->[$i+1]}; 7341 $func = $ref->[$i+2]; 7342 7343 foreach $param (@params) { 7344 $param = exists($pmatch_cache{$param})?$pmatch_cache{$param}:undef; 7345 } 7346 7347 $retval = eval { $func->(@params) }; 7348 7349 # if function call failed or returned false in boolean context 7350 # (undef, "", or 0), set $left to 0, otherwise set $left to 1 7351 7352 if ($@) { 7353 log_msg(LOG_ERR, "Context expression runtime error:", $@); 7354 $left = 0; 7355 } else { 7356 $left = $retval?1:0; 7357 } 7358 7359 } 7360 7361 $i += 3; 7362 7363 } 7364 7365 elsif ($ref->[$i] == VARSET) { 7366 7367 if (defined($left)) { 7368 push @right, VARSET, $ref->[$i+1]; 7369 } else { 7370 $left = exists($pmatch_cache{$ref->[$i+1]})?1:0; 7371 } 7372 7373 $i += 2; 7374 7375 } 7376 7377 } 7378 7379 return $left; 7380 7381} 7382 7383 7384# Parameters: par1 - number of lines the pattern matches (unused) 7385# par2 - pattern (truth value) 7386# par3 - match variable hash 7387# Action: if par2 is TRUE, set par3 to an empty hash and return 1, 7388# otherwise return 0 7389 7390sub match_tvalue { 7391 7392 my(undef, $tvalue, $subst_ref) = @_; 7393 7394 if ($tvalue) { %{$subst_ref} = (); return 1; } 7395 return 0; 7396} 7397 7398 7399# Parameters: par1 - number of lines the pattern matches (unused) 7400# par2 - pattern (cached match) 7401# par3 - match variable hash 7402# Action: if par2 exists, set par3 to the match variable hash pointed by 7403# par2 and return 1, otherwise return 0 7404 7405sub match_cached { 7406 7407 my(undef, $match, $subst_ref) = @_; 7408 7409 if (exists($pmatch_cache{$match})) { 7410 %{$subst_ref} = %{$pmatch_cache{$match}}; 7411 return 1; 7412 } 7413 7414 return 0; 7415} 7416 7417 7418# Parameters: par1 - number of lines the pattern matches (unused) 7419# par2 - pattern (cached match) 7420# par3 - match variable hash 7421# Action: if par2 does not exist, set par3 to empty hash and return 1, 7422# otherwise return 0 7423 7424sub match_ncached { 7425 7426 my(undef, $match, $subst_ref) = @_; 7427 7428 if (!exists($pmatch_cache{$match})) { %{$subst_ref} = (); return 1; } 7429 return 0; 7430} 7431 7432 7433# Parameters: par1 - number of lines the pattern matches 7434# par2 - pattern (string type) 7435# par3 - match variable hash 7436# Action: take par1 last lines from input buffer and concatenate them to 7437# form a single string. If par2 is a substring in the formed 7438# string (both par1 and par2 can contain newlines), set par3 to 7439# an empty hash and return 1, otherwise return 0. 7440 7441sub match_substr { 7442 7443 my($linecount, $substr, $subst_ref) = @_; 7444 my($line, $buffer, $bufptr); 7445 7446 if ($bufsize == 1) { 7447 $line = $input_buffer[0]; 7448 } elsif ($jointbuf) { 7449 $line = join("\n", @input_buffer[$bufpos - $linecount + 1 .. $bufpos]); 7450 } elsif (defined($input_sources[$bufpos])) { 7451 $buffer = $input_buffers{$input_sources[$bufpos]}->{"Events"}; 7452 $bufptr = $input_buffers{$input_sources[$bufpos]}->{"BufPos"}; 7453 $line = join("\n", @{$buffer}[$bufptr - $linecount + 1 .. $bufptr]); 7454 } else { 7455 $buffer = $event_buffer{"Events"}; 7456 $bufptr = $event_buffer{"BufPos"}; 7457 $line = join("\n", @{$buffer}[$bufptr - $linecount + 1 .. $bufptr]); 7458 } 7459 7460 if (index($line, $substr) != -1) { 7461 %{$subst_ref} = (); 7462 return 1; 7463 } 7464 return 0; 7465} 7466 7467 7468# Parameters: par1 - number of lines the pattern matches 7469# par2 - pattern (string type) 7470# par3 - match variable hash (will be emptied) 7471# Action: take par1 last lines from input buffer and concatenate them to 7472# form a single string. If par2 is not a substring in the formed 7473# string (both par1 and par2 can contain newlines), set par3 to 7474# an empty hash and return 1, otherwise return 0. 7475 7476sub match_nsubstr { 7477 7478 my($linecount, $substr, $subst_ref) = @_; 7479 my($line, $buffer, $bufptr); 7480 7481 if ($bufsize == 1) { 7482 $line = $input_buffer[0]; 7483 } elsif ($jointbuf) { 7484 $line = join("\n", @input_buffer[$bufpos - $linecount + 1 .. $bufpos]); 7485 } elsif (defined($input_sources[$bufpos])) { 7486 $buffer = $input_buffers{$input_sources[$bufpos]}->{"Events"}; 7487 $bufptr = $input_buffers{$input_sources[$bufpos]}->{"BufPos"}; 7488 $line = join("\n", @{$buffer}[$bufptr - $linecount + 1 .. $bufptr]); 7489 } else { 7490 $buffer = $event_buffer{"Events"}; 7491 $bufptr = $event_buffer{"BufPos"}; 7492 $line = join("\n", @{$buffer}[$bufptr - $linecount + 1 .. $bufptr]); 7493 } 7494 7495 if (index($line, $substr) == -1) { 7496 %{$subst_ref} = (); 7497 return 1; 7498 } 7499 return 0; 7500} 7501 7502 7503# Parameters: par1 - number of lines the pattern matches 7504# par2 - pattern (regular expression type) 7505# par3 - match variable hash 7506# par4 - variable map hash 7507# Action: take par1 last lines from input buffer and concatenate them to 7508# form a single string. Match the formed string with regular 7509# expression par2, and if par2 contains ()-operators, save 7510# the substring matches to a hash par3. Additional variables are 7511# then created in par3 according to map in par4. If specified with 7512# the map par4, match variable values are cached. If the formed 7513# string matched a regular expression, return 1, otherwise return 0 7514 7515sub match_regexp { 7516 7517 my($linecount, $regexp, $subst_ref, $varmap_ref) = @_; 7518 my($line, $buffer, $bufptr, @matches); 7519 7520 if ($bufsize == 1) { 7521 $line = $input_buffer[0]; 7522 } elsif ($jointbuf) { 7523 $line = join("\n", @input_buffer[$bufpos - $linecount + 1 .. $bufpos]); 7524 } elsif (defined($input_sources[$bufpos])) { 7525 $buffer = $input_buffers{$input_sources[$bufpos]}->{"Events"}; 7526 $bufptr = $input_buffers{$input_sources[$bufpos]}->{"BufPos"}; 7527 $line = join("\n", @{$buffer}[$bufptr - $linecount + 1 .. $bufptr]); 7528 } else { 7529 $buffer = $event_buffer{"Events"}; 7530 $bufptr = $event_buffer{"BufPos"}; 7531 $line = join("\n", @{$buffer}[$bufptr - $linecount + 1 .. $bufptr]); 7532 } 7533 7534 if (@matches = ($line =~ /$regexp/)) { 7535 7536 # since a number of variables are only needed when there is a match, 7537 # declare them in relevant code block only for performance reasons 7538 my($match, $var, $i, $j, @celem); 7539 7540 # overwrite the previous content of the match variable hash with named 7541 # substring matches from the regular expression 7542 %{$subst_ref} = %+; 7543 7544 # add the $<number> match variables to the variable hash 7545 $i = 1; 7546 foreach $match (@matches) { $subst_ref->{$i++} = $match; } 7547 7548 # create the $0 variable 7549 $subst_ref->{"0"} = $line; 7550 7551 # create the $+{_inputsrc} variable 7552 if ($bufsize == 1) { 7553 $subst_ref->{"_inputsrc"} = 7554 defined($input_sources[0])?$input_sources[0]:"synthetic"; 7555 } elsif ($jointbuf) { 7556 $subst_ref->{"_inputsrc"} = join(" ", map(defined($_)?$_:"synthetic", 7557 @input_sources[$bufpos - $linecount + 1 .. $bufpos])); 7558 } else { 7559 $subst_ref->{"_inputsrc"} = 7560 defined($input_sources[$bufpos])?$input_sources[$bufpos]:"synthetic"; 7561 } 7562 7563 # create the $+{_intcontext} variable 7564 $subst_ref->{"_intcontext"} = $intcontextname; 7565 7566 # add the $<name> match variables to the variable hash, 7567 # and add match variable values to pattern match cache 7568 if (scalar(%{$varmap_ref})) { 7569 $j = scalar(@matches); 7570 @celem = (); 7571 while (($var, $i) = each %{$varmap_ref}) { 7572 if (!defined($i)) { push @celem, $var; next; } 7573 $subst_ref->{$var} = ($i <= $j)?$subst_ref->{$i}:undef; 7574 } 7575 foreach $var (@celem) { $pmatch_cache{$var} = { %{$subst_ref} }; } 7576 } 7577 7578 return 1; 7579 } 7580 7581 return 0; 7582} 7583 7584 7585# Parameters: par1 - number of lines the pattern matches 7586# par2 - pattern (regular expression type) 7587# par3 - match variable hash 7588# Action: take par1 last lines from input buffer and concatenate them to 7589# form a single string. Match the formed string with regular 7590# expression par2. If the formed string did not match a regular 7591# expression, return 1, otherwise return 0 7592 7593sub match_nregexp { 7594 7595 my($linecount, $regexp, $subst_ref) = @_; 7596 my($line, $buffer, $bufptr, $source); 7597 7598 if ($bufsize == 1) { 7599 $line = $input_buffer[0]; 7600 } elsif ($jointbuf) { 7601 $line = join("\n", @input_buffer[$bufpos - $linecount + 1 .. $bufpos]); 7602 } elsif (defined($input_sources[$bufpos])) { 7603 $buffer = $input_buffers{$input_sources[$bufpos]}->{"Events"}; 7604 $bufptr = $input_buffers{$input_sources[$bufpos]}->{"BufPos"}; 7605 $line = join("\n", @{$buffer}[$bufptr - $linecount + 1 .. $bufptr]); 7606 } else { 7607 $buffer = $event_buffer{"Events"}; 7608 $bufptr = $event_buffer{"BufPos"}; 7609 $line = join("\n", @{$buffer}[$bufptr - $linecount + 1 .. $bufptr]); 7610 } 7611 7612 if ($line !~ /$regexp/) { 7613 # erase the previous content of the match variable hash, and 7614 # create the $0, $+{_inputsrc} and $+{_intcontext} variables 7615 if ($bufsize == 1) { 7616 $source = defined($input_sources[0])?$input_sources[0]:"synthetic"; 7617 } elsif ($jointbuf) { 7618 $source = join(" ", map(defined($_)?$_:"synthetic", 7619 @input_sources[$bufpos - $linecount + 1 .. $bufpos])); 7620 } else { 7621 $source = 7622 defined($input_sources[$bufpos])?$input_sources[$bufpos]:"synthetic"; 7623 } 7624 %{$subst_ref} = ( "0" => $line, 7625 "_inputsrc" => $source, 7626 "_intcontext" => $intcontextname ); 7627 return 1; 7628 } 7629 7630 return 0; 7631} 7632 7633 7634# Parameters: par1 - number of lines the pattern matches 7635# par2 - pattern (perl function pointer) 7636# par3 - match variable hash 7637# par4 - variable map hash 7638# Action: take par1 last lines from input buffer with corresponding source 7639# names, and pass them to the perl function par2->(). If the function 7640# returned value(s), save them to hash par3 (and cache if specified 7641# by map par4). If the function returned an empty list or returned 7642# a single value FALSE, return 0, otherwise return 1 7643 7644sub match_perlfunc { 7645 7646 my($linecount, $codeptr, $subst_ref, $varmap_ref) = @_; 7647 my(@lines, @sources, $buffer, $bufptr); 7648 my(@matches, $size); 7649 7650 if ($bufsize == 1) { 7651 $lines[0] = $input_buffer[0]; 7652 $sources[0] = $input_sources[0]; 7653 } elsif ($jointbuf) { 7654 @lines = @input_buffer[$bufpos - $linecount + 1 .. $bufpos]; 7655 @sources = @input_sources[$bufpos - $linecount + 1 .. $bufpos]; 7656 } elsif (defined($input_sources[$bufpos])) { 7657 $buffer = $input_buffers{$input_sources[$bufpos]}->{"Events"}; 7658 $bufptr = $input_buffers{$input_sources[$bufpos]}->{"BufPos"}; 7659 @lines = @{$buffer}[$bufptr - $linecount + 1 .. $bufptr]; 7660 $sources[0] = $input_sources[$bufpos]; 7661 } else { 7662 $buffer = $event_buffer{"Events"}; 7663 $bufptr = $event_buffer{"BufPos"}; 7664 @lines = @{$buffer}[$bufptr - $linecount + 1 .. $bufptr]; 7665 $sources[0] = undef; 7666 } 7667 7668 # call the function and save its return values 7669 @matches = eval { $codeptr->(@lines, @sources) }; 7670 7671 # in the case of a function runtime error there is no match 7672 if ($@) { 7673 log_msg(LOG_ERR, "PerlFunc pattern runtime error:", $@); 7674 return 0; 7675 } 7676 7677 # if the function returned no values or a single value which evaluates 7678 # FALSE in boolean context, there is no match, and return 0 immediately 7679 7680 $size = scalar(@matches); 7681 7682 if ($size == 0 || ($size == 1 && !$matches[0])) { return 0; } 7683 7684 # if the function produced a match, set match variables 7685 7686 else { 7687 7688 # since a number of variables are only needed when there is a match, 7689 # declare them in relevant code block only for performance reasons 7690 my($line, $source, $match, $var, $i, $j, @celem); 7691 7692 # initialize the match variable hash 7693 %{$subst_ref} = (); 7694 7695 # if the function returned a hash reference, create named match 7696 # variables from key=value pairs in the hash; otherwise add 7697 # function return values to the variable hash as numeric variables 7698 if ($size == 1 && ref($matches[0]) eq "HASH") { 7699 while ($var = each %{$matches[0]}) { 7700 $subst_ref->{$var} = $matches[0]->{$var}; 7701 } 7702 } else { 7703 $i = 1; 7704 foreach $match (@matches) { $subst_ref->{$i++} = $match; } 7705 } 7706 7707 # create the $0, $+{_inputsrc} and $+{_intcontext} variables 7708 if ($bufsize == 1) { 7709 $line = $input_buffer[0]; 7710 $source = defined($input_sources[0])?$input_sources[0]:"synthetic"; 7711 } elsif ($jointbuf) { 7712 $line = join("\n", @input_buffer[$bufpos - $linecount + 1 .. $bufpos]); 7713 $source = join(" ", map(defined($_)?$_:"synthetic", 7714 @input_sources[$bufpos - $linecount + 1 .. $bufpos])); 7715 } elsif (defined($input_sources[$bufpos])) { 7716 $buffer = $input_buffers{$input_sources[$bufpos]}->{"Events"}; 7717 $bufptr = $input_buffers{$input_sources[$bufpos]}->{"BufPos"}; 7718 $line = join("\n", @{$buffer}[$bufptr - $linecount + 1 .. $bufptr]); 7719 $source = $input_sources[$bufpos]; 7720 } else { 7721 $buffer = $event_buffer{"Events"}; 7722 $bufptr = $event_buffer{"BufPos"}; 7723 $line = join("\n", @{$buffer}[$bufptr - $linecount + 1 .. $bufptr]); 7724 $source = "synthetic"; 7725 } 7726 $subst_ref->{"0"} = $line; 7727 $subst_ref->{"_inputsrc"} = $source; 7728 $subst_ref->{"_intcontext"} = $intcontextname; 7729 7730 # add the $<name> match variables to the variable hash, 7731 # and add match variable values to pattern match cache 7732 if (scalar(%{$varmap_ref})) { 7733 $j = scalar(@matches); 7734 @celem = (); 7735 while (($var, $i) = each %{$varmap_ref}) { 7736 if (!defined($i)) { push @celem, $var; next; } 7737 $subst_ref->{$var} = ($i <= $j)?$subst_ref->{$i}:undef; 7738 } 7739 foreach $var (@celem) { $pmatch_cache{$var} = { %{$subst_ref} }; } 7740 } 7741 7742 return 1; 7743 } 7744} 7745 7746 7747# Parameters: par1 - number of lines the pattern matches 7748# par2 - pattern (perl function pointer) 7749# par3 - match variable hash 7750# Action: take par1 last lines from input buffer with corresponding source 7751# names, and pass them to the perl function par2->(). 7752# If the function returned an empty list or returned 7753# a single value FALSE, return 1, otherwise return 0 7754 7755sub match_nperlfunc { 7756 7757 my($linecount, $codeptr, $subst_ref) = @_; 7758 my(@lines, @sources, $buffer, $bufptr); 7759 my(@matches, $size, $line, $source); 7760 7761 if ($bufsize == 1) { 7762 $lines[0] = $input_buffer[0]; 7763 $sources[0] = $input_sources[0]; 7764 } elsif ($jointbuf) { 7765 @lines = @input_buffer[$bufpos - $linecount + 1 .. $bufpos]; 7766 @sources = @input_sources[$bufpos - $linecount + 1 .. $bufpos]; 7767 } elsif (defined($input_sources[$bufpos])) { 7768 $buffer = $input_buffers{$input_sources[$bufpos]}->{"Events"}; 7769 $bufptr = $input_buffers{$input_sources[$bufpos]}->{"BufPos"}; 7770 @lines = @{$buffer}[$bufptr - $linecount + 1 .. $bufptr]; 7771 $sources[0] = $input_sources[$bufpos]; 7772 } else { 7773 $buffer = $event_buffer{"Events"}; 7774 $bufptr = $event_buffer{"BufPos"}; 7775 @lines = @{$buffer}[$bufptr - $linecount + 1 .. $bufptr]; 7776 $sources[0] = undef; 7777 } 7778 7779 # call the function and save its return values 7780 @matches = eval { $codeptr->(@lines, @sources) }; 7781 7782 # in the case of a function runtime error there is no match 7783 if ($@) { 7784 log_msg(LOG_ERR, "NPerlFunc pattern runtime error:", $@); 7785 return 0; 7786 } 7787 7788 # if the function returned several values or a single value which evaluates 7789 # TRUE in boolean context, there is no match, and return 0 immediately 7790 7791 $size = scalar(@matches); 7792 if ($size > 1 || ($size == 1 && $matches[0])) { return 0; } 7793 7794 # erase the previous content of the match variable hash, and 7795 # create the $0, $+{_inputsrc} and $+{_intcontext} variables 7796 if ($bufsize == 1) { 7797 $line = $input_buffer[0]; 7798 $source = defined($input_sources[0])?$input_sources[0]:"synthetic"; 7799 } elsif ($jointbuf) { 7800 $line = join("\n", @input_buffer[$bufpos - $linecount + 1 .. $bufpos]); 7801 $source = join(" ", map(defined($_)?$_:"synthetic", 7802 @input_sources[$bufpos - $linecount + 1 .. $bufpos])); 7803 } elsif (defined($input_sources[$bufpos])) { 7804 $buffer = $input_buffers{$input_sources[$bufpos]}->{"Events"}; 7805 $bufptr = $input_buffers{$input_sources[$bufpos]}->{"BufPos"}; 7806 $line = join("\n", @{$buffer}[$bufptr - $linecount + 1 .. $bufptr]); 7807 $source = $input_sources[$bufpos]; 7808 } else { 7809 $buffer = $event_buffer{"Events"}; 7810 $bufptr = $event_buffer{"BufPos"}; 7811 $line = join("\n", @{$buffer}[$bufptr - $linecount + 1 .. $bufptr]); 7812 $source = "synthetic"; 7813 } 7814 %{$subst_ref} = ( "0" => $line, 7815 "_inputsrc" => $source, 7816 "_intcontext" => $intcontextname ); 7817 7818 return 1; 7819} 7820 7821 7822# Parameters: par1 - reference to a source action list 7823# par2 - reference to a destination action list 7824# par3 - pointer into the source and destination list 7825# Action: action from list par1 will be copied to par2; the function 7826# will return an offset for advancing the pointer par3 7827 7828sub copy_one_elem_action { 7829 7830 my($src_ref, $dest_ref, $i) = @_; 7831 7832 push @{$dest_ref}, $src_ref->[$i]; 7833 return 1; 7834} 7835 7836sub copy_two_elem_action { 7837 7838 my($src_ref, $dest_ref, $i) = @_; 7839 7840 push @{$dest_ref}, $src_ref->[$i++], $src_ref->[$i]; 7841 return 2; 7842} 7843 7844sub copy_three_elem_action { 7845 7846 my($src_ref, $dest_ref, $i) = @_; 7847 7848 push @{$dest_ref}, $src_ref->[$i++], $src_ref->[$i++], $src_ref->[$i]; 7849 return 3; 7850} 7851 7852sub copy_four_elem_action { 7853 7854 my($src_ref, $dest_ref, $i) = @_; 7855 7856 push @{$dest_ref}, $src_ref->[$i++], $src_ref->[$i++], 7857 $src_ref->[$i++], $src_ref->[$i]; 7858 return 4; 7859} 7860 7861sub copy_five_elem_action { 7862 7863 my($src_ref, $dest_ref, $i) = @_; 7864 7865 push @{$dest_ref}, $src_ref->[$i++], $src_ref->[$i++], 7866 $src_ref->[$i++], $src_ref->[$i++], $src_ref->[$i]; 7867 return 5; 7868} 7869 7870sub copy_cmdexec_spawnexec_action { 7871 7872 my($src_ref, $dest_ref, $i) = @_; 7873 7874 push @{$dest_ref}, $src_ref->[$i++], [ @{$src_ref->[$i]} ]; 7875 return 2; 7876} 7877 7878sub copy_cspawnexec_pipeexec_reportexec_action { 7879 7880 my($src_ref, $dest_ref, $i) = @_; 7881 7882 push @{$dest_ref}, $src_ref->[$i++], $src_ref->[$i++], [ @{$src_ref->[$i]} ]; 7883 return 3; 7884} 7885 7886sub copy_create_set_action { 7887 7888 my($src_ref, $dest_ref, $i) = @_; 7889 7890 push @{$dest_ref}, $src_ref->[$i++], $src_ref->[$i++], $src_ref->[$i++], []; 7891 copy_actionlist($src_ref->[$i], $dest_ref->[$i]); 7892 return 4; 7893} 7894 7895sub copy_call_action { 7896 7897 my($src_ref, $dest_ref, $i) = @_; 7898 7899 push @{$dest_ref}, $src_ref->[$i++], $src_ref->[$i++], 7900 $src_ref->[$i++], [ @{$src_ref->[$i]} ]; 7901 return 4; 7902} 7903 7904sub copy_lcall_action { 7905 7906 my($src_ref, $dest_ref, $i) = @_; 7907 7908 push @{$dest_ref}, $src_ref->[$i++], $src_ref->[$i++], $src_ref->[$i++], 7909 [ @{$src_ref->[$i++]} ], $src_ref->[$i]; 7910 return 5; 7911} 7912 7913sub copy_if_action { 7914 7915 my($src_ref, $dest_ref, $i) = @_; 7916 7917 push @{$dest_ref}, $src_ref->[$i++], $src_ref->[$i++], [], []; 7918 copy_actionlist($src_ref->[$i], $dest_ref->[$i]); 7919 ++$i; 7920 copy_actionlist($src_ref->[$i], $dest_ref->[$i]); 7921 return 4; 7922} 7923 7924sub copy_while_action { 7925 7926 my($src_ref, $dest_ref, $i) = @_; 7927 7928 push @{$dest_ref}, $src_ref->[$i++], $src_ref->[$i++], []; 7929 copy_actionlist($src_ref->[$i], $dest_ref->[$i]); 7930 return 3; 7931} 7932 7933 7934# Parameters: par1 - reference to a source action list 7935# par2 - reference to a destination action list 7936# Action: action list par1 will be copied to par2 7937 7938sub copy_actionlist { 7939 7940 my($src_ref, $dest_ref) = @_; 7941 my($i, $j); 7942 7943 @{$dest_ref} = (); 7944 $i = 0; 7945 $j = scalar(@{$src_ref}); 7946 7947 while ($i < $j) { 7948 $i += $actioncopyfunc[$src_ref->[$i]]->($src_ref, $dest_ref, $i); 7949 } 7950 7951} 7952 7953 7954# Parameters: par1 - reference to a source context 7955# par2 - reference to a destination context 7956# Action: context par1 will be copied to par2 7957 7958sub copy_context { 7959 7960 my($src_ref, $dest_ref) = @_; 7961 my($i, $j); 7962 7963 @{$dest_ref} = (); 7964 $i = 0; 7965 $j = scalar(@{$src_ref}); 7966 7967 while ($i < $j) { 7968 7969 if ($src_ref->[$i] == OPERAND) { 7970 push @{$dest_ref}, OPERAND, $src_ref->[$i+1]; 7971 $i += 2; 7972 } 7973 7974 elsif ($src_ref->[$i] == EXPRESSION) { 7975 push @{$dest_ref}, EXPRESSION, []; 7976 copy_context($src_ref->[$i+1], $dest_ref->[$i+1]); 7977 $i += 2; 7978 } 7979 7980 elsif ($src_ref->[$i] == ECODE) { 7981 push @{$dest_ref}, ECODE, $src_ref->[$i+1]; 7982 $i += 2; 7983 } 7984 7985 elsif ($src_ref->[$i] == CCODE) { 7986 push @{$dest_ref}, CCODE, [ @{$src_ref->[$i+1]} ], $src_ref->[$i+2]; 7987 $i += 3; 7988 } 7989 7990 elsif ($src_ref->[$i] == CCODE2) { 7991 push @{$dest_ref}, CCODE2, [ @{$src_ref->[$i+1]} ], $src_ref->[$i+2]; 7992 $i += 3; 7993 } 7994 7995 elsif ($src_ref->[$i] == VARSET) { 7996 push @{$dest_ref}, VARSET, $src_ref->[$i+1]; 7997 $i += 2; 7998 } 7999 8000 else { 8001 push @{$dest_ref}, $src_ref->[$i]; 8002 ++$i; 8003 } 8004 8005 } 8006 8007} 8008 8009 8010# Parameters: par1 - reference to the hash of match variables 8011# par2, par3, .. - strings that will go through 8012# the substitution procedure 8013# par n - token that special variables start with 8014# Action: Strings par2, par3, .. will be searched for special variables 8015# (like $0, $1, $2, ..) that will be replaced with corresponding 8016# values from hash par1. If the token symbol is followed by 8017# another token symbol, these two symbols will be replaced by 8018# a single token (e.g., $$ -> $). 8019 8020sub subst_string { 8021 8022 my($subst_ref) = shift @_; 8023 my($token) = pop @_; 8024 my($token2, $msg); 8025 8026 $token2 = quotemeta($token); 8027 8028 # variable names in variable map definitions must begin with a letter, but 8029 # since named match variables defined in Perl regular expressions can begin 8030 # both with a letter and underscore, both cases are handled below 8031 8032 foreach $msg (@_) { 8033 8034 if (index($msg, $token) == -1) { next; } 8035 8036 elsif (index($msg, "$token:{") == -1) { 8037 8038 $msg =~ s/$token2(?:$token2|([0-9]+)|\{([0-9]+)\}| 8039 \+\{([[:alpha:]_][\w!]*|[0-9]+)\})/ 8040 !defined($+)?$token:(defined($subst_ref->{$+})?$subst_ref->{$+}:"")/egx; 8041 8042 } else { 8043 8044 # calling defined($pmatch_cache{$4}->{$+}) will create $pmatch_cache{$4} 8045 # if it doesn't exist, thus exists($pmatch_cache{$4}) is called first 8046 8047 $msg =~ s/$token2(?:$token2|([0-9]+)|\{([0-9]+)\}| 8048 \+\{([[:alpha:]_][\w!]*|[0-9]+)\}| 8049 :\{([[:alpha:]]\w*):([[:alpha:]_][\w!]*|[0-9]+)\})/ 8050 !defined($+)?$token: 8051 (!defined($4)?(defined($subst_ref->{$+})?$subst_ref->{$+}:""): 8052 ((exists($pmatch_cache{$4}) && defined($pmatch_cache{$4}->{$+}))? 8053 $pmatch_cache{$4}->{$+}:""))/egx; 8054 } 8055 } 8056 8057} 8058 8059 8060# Parameters: par1 - reference to the array of replacements 8061# par2, par3, .. - regular expressions that will go through 8062# replacement procedure 8063# par n - token that special variables start with 8064# Action: Regular expressions par2, par3, .. will be searched for special 8065# variables (like $1, $2, ..) that will be replaced with 1st, 8066# 2nd, .. element from array par1 8067 8068sub subst_regexp { 8069 8070 my($subst_ref) = shift @_; 8071 my($token) = pop @_; 8072 my($subst, %subst_modified); 8073 8074 %subst_modified = %{$subst_ref}; 8075 8076 while ($subst = each %subst_modified) { 8077 if (defined($subst_modified{$subst})) { 8078 $subst_modified{$subst} = quotemeta($subst_modified{$subst}); 8079 } 8080 } 8081 8082 subst_string(\%subst_modified, @_, $token); 8083 8084} 8085 8086 8087# Parameters: par1 - reference to the array of replacements 8088# par2 - reference to a context expression 8089# par3 - token that special variables start with 8090# Action: Context expression par2 will be searched for special variables 8091# (like $1, $2, ..) that will be replaced with 1st, 2nd, .. element 8092# from array par1 8093 8094sub subst_context { 8095 8096 my($subst_ref, $ref, $token) = @_; 8097 my($i, $j); 8098 8099 $i = 0; 8100 $j = scalar(@{$ref}); 8101 8102 while ($i < $j) { 8103 8104 if ($ref->[$i] == OPERAND || $ref->[$i] == VARSET 8105 || $ref->[$i] == ECODE) { 8106 subst_string($subst_ref, $ref->[$i+1], $token); 8107 $i += 2; 8108 } 8109 8110 elsif ($ref->[$i] == EXPRESSION) { 8111 subst_context($subst_ref, $ref->[$i+1], $token); 8112 $i += 2; 8113 } 8114 8115 elsif ($ref->[$i] == CCODE || $ref->[$i] == CCODE2) { 8116 subst_string($subst_ref, @{$ref->[$i+1]}, $token); 8117 $i += 3; 8118 } 8119 8120 else { ++$i; } 8121 8122 } 8123 8124} 8125 8126 8127# Parameters: par1 - reference to the array of replacements 8128# par2 - reference to the array of replacements (originals) 8129# par3 - reference to action list 8130# par4 - token that special variables start with 8131# par5 - pointer into the action list 8132# Action: action from list par3 will be searched for special variables 8133# (like $1, $2, ..) that will be replaced with 1st, 2nd, .. 8134# element from array par1 or par2; the function will return an offset 8135# for advancing the pointer par5 8136 8137sub subst_none_break_continue { return 1; } 8138 8139sub subst_free { return 2; } 8140 8141sub subst_two_elem_action { 8142 8143 my($subst_ref, undef, $actionlist, $token, $i) = @_; 8144 8145 subst_string($subst_ref, $actionlist->[$i+1], $token); 8146 return 2; 8147} 8148 8149sub subst_three_elem_action { 8150 8151 my($subst_ref, undef, $actionlist, $token, $i) = @_; 8152 8153 subst_string($subst_ref, $actionlist->[$i+1], $token); 8154 subst_string($subst_ref, $actionlist->[$i+2], $token); 8155 return 3; 8156} 8157 8158sub subst_four_elem_action { 8159 8160 my($subst_ref, undef, $actionlist, $token, $i) = @_; 8161 8162 subst_string($subst_ref, $actionlist->[$i+1], $token); 8163 subst_string($subst_ref, $actionlist->[$i+2], $token); 8164 subst_string($subst_ref, $actionlist->[$i+3], $token); 8165 return 4; 8166} 8167 8168sub subst_cmdexec_spawnexec_action { 8169 8170 my($subst_ref, undef, $actionlist, $token, $i) = @_; 8171 8172 subst_string($subst_ref, @{$actionlist->[$i+1]}, $token); 8173 return 2; 8174} 8175 8176sub subst_cspawnexec_pipeexec_reportexec_action { 8177 8178 my($subst_ref, undef, $actionlist, $token, $i) = @_; 8179 8180 subst_string($subst_ref, $actionlist->[$i+1], $token); 8181 subst_string($subst_ref, @{$actionlist->[$i+2]}, $token); 8182 return 3; 8183} 8184 8185sub subst_create_set_action { 8186 8187 my($subst_ref, $subst_orig_ref, $actionlist, $token, $i) = @_; 8188 8189 subst_string($subst_ref, $actionlist->[$i+1], $token); 8190 subst_string($subst_ref, $actionlist->[$i+2], $token); 8191 subst_actionlist($subst_orig_ref, $actionlist->[$i+3], $token); 8192 return 4; 8193} 8194 8195sub subst_copy_empty_etc_action { 8196 8197 my($subst_ref, undef, $actionlist, $token, $i) = @_; 8198 8199 subst_string($subst_ref, $actionlist->[$i+1], $token); 8200 return 3; 8201} 8202 8203sub subst_event_assign_etc_action { 8204 8205 my($subst_ref, undef, $actionlist, $token, $i) = @_; 8206 8207 subst_string($subst_ref, $actionlist->[$i+2], $token); 8208 return 3; 8209} 8210 8211sub subst_reset_action { 8212 8213 my($subst_ref, undef, $actionlist, $token, $i) = @_; 8214 8215 subst_string($subst_ref, $actionlist->[$i+3], $token); 8216 return 4; 8217} 8218 8219sub subst_getwpos_action { 8220 8221 my($subst_ref, undef, $actionlist, $token, $i) = @_; 8222 8223 subst_string($subst_ref, $actionlist->[$i+4], $token); 8224 return 5; 8225} 8226 8227sub subst_setwpos_action { 8228 8229 my($subst_ref, undef, $actionlist, $token, $i) = @_; 8230 8231 subst_string($subst_ref, $actionlist->[$i+1], $token); 8232 subst_string($subst_ref, $actionlist->[$i+4], $token); 8233 return 5; 8234} 8235 8236sub subst_call_action { 8237 8238 my($subst_ref, undef, $actionlist, $token, $i) = @_; 8239 8240 subst_string($subst_ref, @{$actionlist->[$i+3]}, $token); 8241 return 4; 8242} 8243 8244sub subst_lcall_action { 8245 8246 my($subst_ref, undef, $actionlist, $token, $i) = @_; 8247 8248 subst_string($subst_ref, @{$actionlist->[$i+3]}, $token); 8249 return 5; 8250} 8251 8252sub subst_if_action { 8253 8254 my(undef, $subst_orig_ref, $actionlist, $token, $i) = @_; 8255 8256 subst_actionlist($subst_orig_ref, $actionlist->[$i+2], $token); 8257 subst_actionlist($subst_orig_ref, $actionlist->[$i+3], $token); 8258 return 4; 8259} 8260 8261sub subst_while_action { 8262 8263 my(undef, $subst_orig_ref, $actionlist, $token, $i) = @_; 8264 8265 subst_actionlist($subst_orig_ref, $actionlist->[$i+2], $token); 8266 return 3; 8267} 8268 8269 8270# Parameters: par1 - reference to the array of replacements 8271# par2 - reference to action list 8272# par3 - token that special variables start with 8273# Action: action list par2 will be searched for special variables 8274# (like $1, $2, ..) that will be replaced with 1st, 2nd, .. 8275# element from array par1 8276 8277sub subst_actionlist { 8278 8279 my($subst_ref, $actionlist, $token) = @_; 8280 my($subst, %subst_modified); 8281 my($i, $j); 8282 8283 # mask %-signs in substitutions, in order to prevent incorrect 8284 # %<alnum>-variable interpretations 8285 8286 %subst_modified = %{$subst_ref}; 8287 8288 while ($subst = each %subst_modified) { 8289 if (defined($subst_modified{$subst})) { 8290 $subst_modified{$subst} =~ s/%/%%/g; 8291 } 8292 } 8293 8294 # process the action list 8295 8296 $i = 0; 8297 $j = scalar(@{$actionlist}); 8298 8299 while ($i < $j) { 8300 $i += $actionsubstfunc[$actionlist->[$i]]->(\%subst_modified, 8301 $subst_ref, 8302 $actionlist, 8303 $token, $i); 8304 } 8305 8306} 8307 8308 8309# Parameters: par1 - reference to an operation from list %corr_list 8310# par2 - timestamp 8311# par3 - flag (optional) 8312# Action: search the list of event occurrence times of the SingleWithThreshold 8313# or SingleWith2Thresholds operation which is pointed by par1; 8314# list elements which are older than par2 will be removed. 8315# If flag par3 is set, the beginning of the event correlation 8316# window for operation par1 will be set to par2; otherwise it will 8317# be set to the earliest remaining occurrence time in the list. 8318 8319sub update_times_swt { 8320 8321 my($oper, $time, $flag) = @_; 8322 my($tlist); 8323 8324 $tlist = $oper->{"Times"}; 8325 8326 while (scalar(@{$tlist})) { 8327 if ($tlist->[0] >= $time) { last; } 8328 shift @{$tlist}; 8329 } 8330 8331 if (!defined($flag) && scalar(@{$tlist})) { 8332 $oper->{"Time"} = $tlist->[0]; 8333 } else { 8334 $oper->{"Time"} = $time; 8335 } 8336 8337} 8338 8339 8340# Parameters: par1 - reference to an operation from list %corr_list 8341# par2 - timestamp 8342# par3 - flag (optional) 8343# Action: search the list of event occurrence times of the EventGroup 8344# operation which is pointed by par1; list elements which are older 8345# than par2 will be removed. 8346# If flag par3 is set, the beginning of the event correlation 8347# window for operation par1 will be set to par2; otherwise it will 8348# be set to the earliest remaining occurrence time in the list. 8349 8350sub update_times_eg { 8351 8352 my($oper, $time, $flag) = @_; 8353 my($tlist, $i); 8354 8355 $tlist = $oper->{"AllTimes"}; 8356 8357 while (scalar(@{$tlist})) { 8358 if ($tlist->[0]->[0] >= $time) { last; } 8359 $i = $tlist->[0]->[1]; 8360 shift @{$oper->{"TimesList"}->[$i]}; 8361 shift @{$tlist}; 8362 } 8363 8364 if (!defined($flag) && scalar(@{$tlist})) { 8365 $oper->{"Time"} = $tlist->[0]->[0]; 8366 } else { 8367 $oper->{"Time"} = $time; 8368 } 8369 8370} 8371 8372 8373# Parameters: par1 - event group string 8374# par2 - event group matching pattern 8375# Action: match event group string par1 with event group pattern par2; 8376# return 1 if match was found, otherwise return 0 8377 8378sub match_eventgroup_substr { 8379 8380 my($string, $substr) = @_; 8381 8382 if (index($string, $substr) != -1) { return 1; } 8383 return 0; 8384} 8385 8386 8387sub match_eventgroup_nsubstr { 8388 8389 my($string, $substr) = @_; 8390 8391 if (index($string, $substr) == -1) { return 1; } 8392 return 0; 8393} 8394 8395 8396sub match_eventgroup_regexp { 8397 8398 my($string, $regexp) = @_; 8399 8400 if ($string =~ /$regexp/) { return 1; } 8401 return 0; 8402} 8403 8404 8405sub match_eventgroup_nregexp { 8406 8407 my($string, $regexp) = @_; 8408 8409 if ($string !~ /$regexp/) { return 1; } 8410 return 0; 8411} 8412 8413 8414sub match_eventgroup_perlfunc { 8415 8416 my($string, $codeptr) = @_; 8417 my($retval); 8418 8419 # call the function and save its return value; 8420 # in the case of a function runtime error there is no match 8421 8422 $retval = eval { $codeptr->($string) }; 8423 8424 if ($@) { 8425 log_msg(LOG_ERR, "PerlFunc pattern runtime error:", $@); 8426 return 0; 8427 } 8428 8429 # if the function returned a value which evaluates true in boolean 8430 # context (neither undef, nor "", nor 0), return 1, otherwise return 0 8431 8432 if ($retval) { return 1; } 8433 return 0; 8434} 8435 8436 8437sub match_eventgroup_nperlfunc { 8438 8439 my($string, $codeptr) = @_; 8440 my($retval); 8441 8442 # call the function and save its return value; 8443 # in the case of a function runtime error there is no match 8444 8445 $retval = eval { $codeptr->($string) }; 8446 8447 if ($@) { 8448 log_msg(LOG_ERR, "NPerlFunc pattern runtime error:", $@); 8449 return 0; 8450 } 8451 8452 # if the function returned a value which evaluates false in boolean 8453 # context (undef, "", or 0), return 1, otherwise return 0 8454 8455 if (!$retval) { return 1; } 8456 return 0; 8457} 8458 8459 8460# Parameters: par1, par2, .. - strings 8461# Action: calculate unique key for strings par1, par2, .. that will be 8462# used in correlation lists to distinguish between differents events 8463 8464sub gen_key { 8465 return join(SEPARATOR, @_); 8466} 8467 8468 8469# Parameters: par1 - reference to the rule definition 8470# par2 - reference to the hash of match values 8471# Action: process the Single rule after a match has been found 8472 8473sub process_single_rule { 8474 8475 my($rule, $subst) = @_; 8476 my($desc, $action); 8477 8478 $desc = $rule->{"Desc"}; 8479 8480 if (scalar(%{$subst})) { 8481 8482 if (exists($rule->{"ActVolat"})) { 8483 $action = []; 8484 copy_actionlist($rule->{"Action"}, $action); 8485 subst_actionlist($subst, $action, '$'); 8486 } else { $action = $rule->{"Action"}; } 8487 8488 subst_string($subst, $desc, '$'); 8489 8490 } else { $action = $rule->{"Action"}; } 8491 8492 execute_actionlist($action, $desc); 8493 8494} 8495 8496 8497# Parameters: par1 - reference to the rule definition 8498# par2 - reference to the hash of match values 8499# Action: process the SingleWithScript rule after a match has been found 8500 8501sub process_singlewithscript_rule { 8502 8503 my($rule, $subst) = @_; 8504 my(@script, $script, $shell, $desc, $pid); 8505 my($action, $action2); 8506 8507 $desc = $rule->{"Desc"}; 8508 8509 # check if the command line provided with the 'script' field has to be 8510 # executed without shell interpretation, and if yes, copy the command 8511 # line arguments into local array @script 8512 8513 if (ref($rule->{"Script"}) eq "ARRAY") { 8514 @script = @{$rule->{"Script"}}; 8515 $shell = 0; 8516 } else { 8517 $script = $rule->{"Script"}; 8518 $shell = 1; 8519 } 8520 8521 if (scalar(%{$subst})) { 8522 8523 if (exists($rule->{"ActVolat"})) { 8524 $action = []; 8525 copy_actionlist($rule->{"Action"}, $action); 8526 subst_actionlist($subst, $action, '$'); 8527 } else { $action = $rule->{"Action"}; } 8528 8529 if (exists($rule->{"ActVolat2"})) { 8530 $action2 = []; 8531 copy_actionlist($rule->{"Action2"}, $action2); 8532 subst_actionlist($subst, $action2, '$'); 8533 } else { $action2 = $rule->{"Action2"}; } 8534 8535 if ($shell) { 8536 subst_string($subst, $desc, $script, '$'); 8537 } else { 8538 subst_string($subst, $desc, @script, '$'); 8539 } 8540 8541 } else { 8542 $action = $rule->{"Action"}; 8543 $action2 = $rule->{"Action2"}; 8544 } 8545 8546 # if the command line provided with the 'script' field has to be 8547 # executed without shell interpretation, pass a reference to the 8548 # array @script with command line arguments to pipe_cmd() function 8549 8550 if ($shell) { 8551 $pid = pipe_cmd($script, \%context_list); 8552 } else { 8553 $pid = pipe_cmd(\@script, \%context_list); 8554 } 8555 8556 if (defined($pid)) { 8557 $children{$pid}->{"Desc"} = $desc; 8558 $children{$pid}->{"Action"} = $action; 8559 $children{$pid}->{"Action2"} = $action2; 8560 } 8561 8562} 8563 8564 8565# Parameters: par1 - reference to the rule definition 8566# par2 - reference to the hash of match values 8567# par3 - name of the configuration file 8568# Action: process the SingleWithSuppress rule after a match has been found 8569 8570sub process_singlewithsuppress_rule { 8571 8572 my($rule, $subst, $conffile) = @_; 8573 my($desc, $key, $time, $action); 8574 8575 $desc = $rule->{"Desc"}; 8576 if (scalar(%{$subst})) { subst_string($subst, $desc, '$'); } 8577 8578 $key = gen_key($conffile, $rule->{"ID"}, $desc); 8579 $time = time(); 8580 8581 # if there is no event correlation operation for the key, or 8582 # the operation with the key has expired, start the new operation 8583 8584 if (!exists($corr_list{$key}) || 8585 $time - $corr_list{$key}->{"Time"} > $corr_list{$key}->{"Window"}) { 8586 8587 if (scalar(%{$subst}) && exists($rule->{"ActVolat"})) { 8588 $action = []; 8589 copy_actionlist($rule->{"Action"}, $action); 8590 subst_actionlist($subst, $action, '$'); 8591 } else { $action = $rule->{"Action"}; } 8592 8593 $corr_list{$key} = { "StartTime" => $time, 8594 "Time" => $time, 8595 "Type" => $rule->{"Type"}, 8596 "File" => $conffile, 8597 "ID" => $rule->{"ID"}, 8598 "Window" => $rule->{"Window"}, 8599 "Desc" => $desc, 8600 "Action" => $action }; 8601 8602 execute_actionlist($action, $desc); 8603 } 8604 8605} 8606 8607 8608# Parameters: par1 - reference to the rule definition 8609# par2 - reference to the hash of match values 8610# par3 - name of the configuration file 8611# Action: process the Pair rule after a match has been found 8612 8613sub process_pair_rule { 8614 8615 my($rule, $subst, $conffile) = @_; 8616 my($desc, $key, $time, $temppat, $pattern2, $desc2); 8617 my($action, $action2, $context2, $sub, $act2copied); 8618 8619 $desc = $rule->{"Desc"}; 8620 if (scalar(%{$subst})) { subst_string($subst, $desc, '$'); } 8621 8622 $key = gen_key($conffile, $rule->{"ID"}, $desc); 8623 $time = time(); 8624 8625 # if there is no event correlation operation for the key, or 8626 # the operation with the key has expired, start the new operation 8627 8628 if (!exists($corr_list{$key}) || ($corr_list{$key}->{"Window"} && 8629 $time - $corr_list{$key}->{"Time"} > $corr_list{$key}->{"Window"})) { 8630 8631 $pattern2 = $rule->{"Pattern2"}; 8632 $desc2 = $rule->{"Desc2"}; 8633 8634 if (scalar(%{$subst})) { 8635 8636 if (exists($rule->{"ActVolat"})) { 8637 $action = []; 8638 copy_actionlist($rule->{"Action"}, $action); 8639 subst_actionlist($subst, $action, '$'); 8640 } else { $action = $rule->{"Action"}; } 8641 8642 if (exists($rule->{"ActVolat2"})) { 8643 $action2 = []; 8644 copy_actionlist($rule->{"Action2"}, $action2); 8645 $act2copied = 1; 8646 } else { $action2 = $rule->{"Action2"}; } 8647 8648 if (exists($rule->{"ContVolat2"})) { 8649 $context2 = []; 8650 copy_context($rule->{"Context2"}, $context2); 8651 } else { $context2 = $rule->{"Context2"}; } 8652 8653 if ($rule->{"PatType2"} == REGEXP || 8654 $rule->{"PatType2"} == NREGEXP) { 8655 8656 if (exists($rule->{"Pat2NotCompiled"})) { 8657 8658 subst_regexp($subst, $pattern2, '$'); 8659 $temppat = $pattern2; 8660 $pattern2 = eval { qr/$pattern2/ }; 8661 8662 if ($@) { 8663 log_msg(LOG_ERR, "Runtime variable evaluation yielded an invalid regular expression '$temppat' for Pair rule:", $@); 8664 log_msg(LOG_ERR, "Can't start Pair event correlation operation with the key '$key'"); 8665 return; 8666 } 8667 } 8668 8669 # mask all $-symbols in substitutions, in order to prevent 8670 # false interpretations when the second pattern matches 8671 8672 while ($sub = each %{$subst}) { 8673 if (defined($subst->{$sub})) { $subst->{$sub} =~ s/\$/\$\$/g; } 8674 } 8675 8676 subst_string($subst, $desc2, '%'); 8677 8678 if (exists($rule->{"ActVolat2"})) { 8679 subst_actionlist($subst, $action2, '%'); 8680 } 8681 if (exists($rule->{"ContVolat2"})) { 8682 subst_context($subst, $context2, '%'); 8683 } 8684 8685 } elsif ($rule->{"PatType2"} == PERLFUNC || 8686 $rule->{"PatType2"} == NPERLFUNC || 8687 $rule->{"PatType2"} == CACHED) { 8688 8689 # mask all $-symbols in substitutions, in order to prevent 8690 # false interpretations when the second pattern matches 8691 8692 while ($sub = each %{$subst}) { 8693 if (defined($subst->{$sub})) { $subst->{$sub} =~ s/\$/\$\$/g; } 8694 } 8695 8696 subst_string($subst, $desc2, '%'); 8697 8698 if (exists($rule->{"ActVolat2"})) { 8699 subst_actionlist($subst, $action2, '%'); 8700 } 8701 if (exists($rule->{"ContVolat2"})) { 8702 subst_context($subst, $context2, '%'); 8703 } 8704 8705 } elsif ($rule->{"PatType2"} == SUBSTR || 8706 $rule->{"PatType2"} == NSUBSTR) { 8707 8708 subst_string($subst, $pattern2, $desc2, '$'); 8709 8710 if (exists($rule->{"ActVolat2"})) { 8711 subst_actionlist($subst, $action2, '$'); 8712 } 8713 if (exists($rule->{"ContVolat2"})) { 8714 subst_context($subst, $context2, '$'); 8715 } 8716 8717 } elsif ($rule->{"PatType2"} == NCACHED || 8718 $rule->{"PatType2"} == TVALUE) { 8719 8720 subst_string($subst, $desc2, '$'); 8721 8722 if (exists($rule->{"ActVolat2"})) { 8723 subst_actionlist($subst, $action2, '$'); 8724 } 8725 if (exists($rule->{"ContVolat2"})) { 8726 subst_context($subst, $context2, '$'); 8727 } 8728 } 8729 8730 } else { 8731 8732 $action = $rule->{"Action"}; 8733 $action2 = $rule->{"Action2"}; 8734 $context2 = $rule->{"Context2"}; 8735 } 8736 8737 $corr_list{$key} = { "StartTime" => $time, 8738 "Time" => $time, 8739 "Type" => $rule->{"Type"}, 8740 "File" => $conffile, 8741 "ID" => $rule->{"ID"}, 8742 "Window" => $rule->{"Window"}, 8743 "Desc" => $desc, 8744 "Action" => $action, 8745 "Pattern2" => $pattern2, 8746 "Context2" => $context2, 8747 "Desc2" => $desc2, 8748 "Action2" => $action2 }; 8749 8750 if (defined($act2copied)) { $corr_list{$key}->{"Act2Copied"} = 1; } 8751 $rule->{"Operations"}->{$key} = $corr_list{$key}; 8752 8753 execute_actionlist($action, $desc); 8754 } 8755 8756} 8757 8758 8759# Parameters: par1 - reference to the rule definition 8760# par2 - reference to the hash of match values 8761# par3 - name of the configuration file 8762# Action: process the PairWithWindow rule after a match has been found 8763 8764sub process_pairwithwindow_rule { 8765 8766 my($rule, $subst, $conffile) = @_; 8767 my($desc, $key, $time, $temppat, $pattern2, $desc2); 8768 my($action, $action2, $context2, $sub, $act2copied); 8769 8770 $desc = $rule->{"Desc"}; 8771 if (scalar(%{$subst})) { subst_string($subst, $desc, '$'); } 8772 8773 $key = gen_key($conffile, $rule->{"ID"}, $desc); 8774 $time = time(); 8775 8776 # if there is an event correlation operation for the key and 8777 # the operation has expired, execute the first action list and 8778 # terminate the operation 8779 8780 if (exists($corr_list{$key}) && 8781 $time - $corr_list{$key}->{"Time"} > $corr_list{$key}->{"Window"}) { 8782 8783 execute_actionlist($corr_list{$key}->{"Action"}, $desc); 8784 delete $corr_list{$key}; 8785 delete $rule->{"Operations"}->{$key}; 8786 } 8787 8788 # if there is no event correlation operation for the key, 8789 # start the new operation 8790 8791 if (!exists($corr_list{$key})) { 8792 8793 $pattern2 = $rule->{"Pattern2"}; 8794 $desc2 = $rule->{"Desc2"}; 8795 8796 if (scalar(%{$subst})) { 8797 8798 if (exists($rule->{"ActVolat"})) { 8799 $action = []; 8800 copy_actionlist($rule->{"Action"}, $action); 8801 subst_actionlist($subst, $action, '$'); 8802 } else { $action = $rule->{"Action"}; } 8803 8804 if (exists($rule->{"ActVolat2"})) { 8805 $action2 = []; 8806 copy_actionlist($rule->{"Action2"}, $action2); 8807 $act2copied = 1; 8808 } else { $action2 = $rule->{"Action2"}; } 8809 8810 if (exists($rule->{"ContVolat2"})) { 8811 $context2 = []; 8812 copy_context($rule->{"Context2"}, $context2); 8813 } else { $context2 = $rule->{"Context2"}; } 8814 if ($rule->{"PatType2"} == REGEXP || 8815 $rule->{"PatType2"} == NREGEXP) { 8816 8817 if (exists($rule->{"Pat2NotCompiled"})) { 8818 8819 subst_regexp($subst, $pattern2, '$'); 8820 $temppat = $pattern2; 8821 $pattern2 = eval { qr/$pattern2/ }; 8822 8823 if ($@) { 8824 log_msg(LOG_ERR, "Runtime variable evaluation yielded an invalid regular expression '$temppat' for PairWithWindow rule:", $@); 8825 log_msg(LOG_ERR, "Can't start PairWithWindow event correlation operation with the key '$key'"); 8826 return; 8827 } 8828 } 8829 8830 # mask all $-symbols in substitutions, in order to prevent 8831 # false interpretations when the second pattern matches 8832 8833 while ($sub = each %{$subst}) { 8834 if (defined($subst->{$sub})) { $subst->{$sub} =~ s/\$/\$\$/g; } 8835 } 8836 8837 subst_string($subst, $desc2, '%'); 8838 8839 if (exists($rule->{"ActVolat2"})) { 8840 subst_actionlist($subst, $action2, '%'); 8841 } 8842 if (exists($rule->{"ContVolat2"})) { 8843 subst_context($subst, $context2, '%'); 8844 } 8845 8846 } elsif ($rule->{"PatType2"} == PERLFUNC || 8847 $rule->{"PatType2"} == NPERLFUNC || 8848 $rule->{"PatType2"} == CACHED) { 8849 8850 # mask all $-symbols in substitutions, in order to prevent 8851 # false interpretations when the second pattern matches 8852 8853 while ($sub = each %{$subst}) { 8854 if (defined($subst->{$sub})) { $subst->{$sub} =~ s/\$/\$\$/g; } 8855 } 8856 8857 subst_string($subst, $desc2, '%'); 8858 8859 if (exists($rule->{"ActVolat2"})) { 8860 subst_actionlist($subst, $action2, '%'); 8861 } 8862 if (exists($rule->{"ContVolat2"})) { 8863 subst_context($subst, $context2, '%'); 8864 } 8865 8866 } elsif ($rule->{"PatType2"} == SUBSTR || 8867 $rule->{"PatType2"} == NSUBSTR) { 8868 8869 subst_string($subst, $pattern2, $desc2, '$'); 8870 8871 if (exists($rule->{"ActVolat2"})) { 8872 subst_actionlist($subst, $action2, '$'); 8873 } 8874 if (exists($rule->{"ContVolat2"})) { 8875 subst_context($subst, $context2, '$'); 8876 } 8877 8878 } elsif ($rule->{"PatType2"} == NCACHED || 8879 $rule->{"PatType2"} == TVALUE) { 8880 8881 subst_string($subst, $desc2, '$'); 8882 8883 if (exists($rule->{"ActVolat2"})) { 8884 subst_actionlist($subst, $action2, '$'); 8885 } 8886 if (exists($rule->{"ContVolat2"})) { 8887 subst_context($subst, $context2, '$'); 8888 } 8889 } 8890 8891 } else { 8892 8893 $action = $rule->{"Action"}; 8894 $action2 = $rule->{"Action2"}; 8895 $context2 = $rule->{"Context2"}; 8896 } 8897 8898 $corr_list{$key} = { "StartTime" => $time, 8899 "Time" => $time, 8900 "Type" => $rule->{"Type"}, 8901 "File" => $conffile, 8902 "ID" => $rule->{"ID"}, 8903 "Window" => $rule->{"Window"}, 8904 "Desc" => $desc, 8905 "Action" => $action, 8906 "Pattern2" => $pattern2, 8907 "Context2" => $context2, 8908 "Desc2" => $desc2, 8909 "Action2" => $action2 }; 8910 8911 if (defined($act2copied)) { $corr_list{$key}->{"Act2Copied"} = 1; } 8912 $rule->{"Operations"}->{$key} = $corr_list{$key}; 8913 } 8914 8915} 8916 8917 8918# Parameters: par1 - reference to the rule definition 8919# par2 - reference to the hash of match values 8920# par3 - name of the configuration file 8921# Action: process the SingleWithThreshold rule after a match has been found 8922 8923sub process_singlewiththreshold_rule { 8924 8925 my($rule, $subst, $conffile) = @_; 8926 my($desc, $key, $time, $oper, $action, $action2); 8927 8928 $desc = $rule->{"Desc"}; 8929 if (scalar(%{$subst})) { subst_string($subst, $desc, '$'); } 8930 8931 $key = gen_key($conffile, $rule->{"ID"}, $desc); 8932 $time = time(); 8933 8934 # if there exists event correlation operation for the key and its window 8935 # has expired, slide the window forward or terminate the operation 8936 8937 if (exists($corr_list{$key}) && 8938 $time - $corr_list{$key}->{"Time"} > $corr_list{$key}->{"Window"}) { 8939 8940 $oper = $corr_list{$key}; 8941 8942 if (!exists($oper->{"SuppressMode"})) { 8943 8944 # if the operation is not in event suppressing mode, slide the window 8945 # forward; if no events remain in the window, terminate the operation 8946 8947 update_times_swt($oper, $time - $oper->{"Window"}); 8948 if (!scalar(@{$oper->{"Times"}})) { delete $corr_list{$key}; } 8949 8950 } else { 8951 8952 # if the operation is in event suppressing mode, terminate it 8953 8954 execute_actionlist($oper->{"Action2"}, $desc); 8955 delete $corr_list{$key}; 8956 } 8957 } 8958 8959 # if there was no event correlation operation for the key when this 8960 # function was called (or the operation was terminated previously 8961 # within this function), start the new operation 8962 8963 if (!exists($corr_list{$key})) { 8964 8965 if (scalar(%{$subst})) { 8966 8967 if (exists($rule->{"ActVolat"})) { 8968 $action = []; 8969 copy_actionlist($rule->{"Action"}, $action); 8970 subst_actionlist($subst, $action, '$'); 8971 } else { $action = $rule->{"Action"}; } 8972 8973 if (exists($rule->{"ActVolat2"})) { 8974 $action2 = []; 8975 copy_actionlist($rule->{"Action2"}, $action2); 8976 subst_actionlist($subst, $action2, '$'); 8977 } else { $action2 = $rule->{"Action2"}; } 8978 8979 } else { 8980 $action = $rule->{"Action"}; 8981 $action2 = $rule->{"Action2"}; 8982 } 8983 8984 $corr_list{$key} = { "StartTime" => $time, 8985 "Time" => $time, 8986 "Type" => $rule->{"Type"}, 8987 "File" => $conffile, 8988 "ID" => $rule->{"ID"}, 8989 "Window" => $rule->{"Window"}, 8990 "Times" => [], 8991 "Desc" => $desc, 8992 "Action" => $action, 8993 "Action2" => $action2 }; 8994 } 8995 8996 $oper = $corr_list{$key}; 8997 8998 # if the operation is in event suppressing mode, return 8999 if (exists($oper->{"SuppressMode"})) { return; } 9000 9001 # record data about the current event into occurrence time list 9002 push @{$oper->{"Times"}}, $time; 9003 9004 # return if the number of events in the list is below threshold 9005 if (scalar(@{$oper->{"Times"}}) < $rule->{"Threshold"}) { return; } 9006 9007 # if the threshold condition is met, go to suppressing mode 9008 $oper->{"SuppressMode"} = 1; 9009 9010 # execute the rule action (if setwpos action gets executed for 9011 # the operation, it will appear in suppressing mode) 9012 execute_actionlist($oper->{"Action"}, $desc); 9013 9014} 9015 9016 9017# Parameters: par1 - reference to the rule definition 9018# par2 - reference to the hash of match values 9019# par3 - name of the configuration file 9020# Action: process the SingleWith2Thresholds rule after a match has been found 9021 9022sub process_singlewith2thresholds_rule { 9023 9024 my($rule, $subst, $conffile) = @_; 9025 my($desc, $key, $time, $oper, $desc2, $action, $action2); 9026 9027 $desc = $rule->{"Desc"}; 9028 if (scalar(%{$subst})) { subst_string($subst, $desc, '$'); } 9029 9030 $key = gen_key($conffile, $rule->{"ID"}, $desc); 9031 $time = time(); 9032 9033 # if there exists event correlation operation for the key and its window 9034 # has expired, slide the window forward or terminate the operation 9035 9036 if (exists($corr_list{$key}) && 9037 $time - $corr_list{$key}->{"Time"} > $corr_list{$key}->{"Window"}) { 9038 9039 $oper = $corr_list{$key}; 9040 9041 if (!exists($oper->{"2ndPass"})) { 9042 9043 # if the operation is in rising threshold mode, slide the window 9044 # forward; if no events remain in the window, terminate the operation 9045 9046 update_times_swt($oper, $time - $oper->{"Window"}); 9047 if (!scalar(@{$oper->{"Times"}})) { delete $corr_list{$key}; } 9048 9049 } else { 9050 9051 # if the operation is in falling threshold mode, terminate it 9052 9053 execute_actionlist($oper->{"Action2"}, $oper->{"Desc2"}); 9054 delete $corr_list{$key}; 9055 } 9056 } 9057 9058 # if there was no event correlation operation for the key when this 9059 # function was called (or the operation was terminated previously 9060 # within this function), start the new operation 9061 9062 if (!exists($corr_list{$key})) { 9063 9064 $desc2 = $rule->{"Desc2"}; 9065 9066 if (scalar(%{$subst})) { 9067 9068 if (exists($rule->{"ActVolat"})) { 9069 $action = []; 9070 copy_actionlist($rule->{"Action"}, $action); 9071 subst_actionlist($subst, $action, '$'); 9072 } else { $action = $rule->{"Action"}; } 9073 9074 if (exists($rule->{"ActVolat2"})) { 9075 $action2 = []; 9076 copy_actionlist($rule->{"Action2"}, $action2); 9077 subst_actionlist($subst, $action2, '$'); 9078 } else { $action2 = $rule->{"Action2"}; } 9079 9080 subst_string($subst, $desc2, '$'); 9081 9082 } else { 9083 $action = $rule->{"Action"}; 9084 $action2 = $rule->{"Action2"}; 9085 } 9086 9087 $corr_list{$key} = { "StartTime" => $time, 9088 "Time" => $time, 9089 "Type" => $rule->{"Type"}, 9090 "File" => $conffile, 9091 "ID" => $rule->{"ID"}, 9092 "Window" => $rule->{"Window"}, 9093 "Times" => [], 9094 "Desc" => $desc, 9095 "Action" => $action, 9096 "Desc2" => $desc2, 9097 "Action2" => $action2 }; 9098 } 9099 9100 $oper = $corr_list{$key}; 9101 9102 # record data about the current event into occurrence time list 9103 push @{$oper->{"Times"}}, $time; 9104 9105 if (!exists($oper->{"2ndPass"})) { 9106 9107 # the operation is in rising threshold mode: 9108 # return if the number of events in the list is below threshold 9109 if (scalar(@{$oper->{"Times"}}) < $rule->{"Threshold"}) { return; } 9110 9111 # if the threshold condition is met, go to falling threshold mode 9112 9113 $oper->{"2ndPass"} = 1; 9114 $oper->{"Time"} = $time; 9115 $oper->{"Window"} = $rule->{"Window2"}; 9116 @{$oper->{"Times"}} = (); 9117 9118 # execute the rule action (if setwpos action gets executed for 9119 # the operation, it will appear in falling threshold mode) 9120 execute_actionlist($oper->{"Action"}, $desc); 9121 9122 } else { 9123 9124 # the operation is in falling threshold mode: 9125 # return if the number of events in the list is not greater than threshold 9126 if (scalar(@{$oper->{"Times"}}) <= $rule->{"Threshold2"}) { return; } 9127 9128 # if the threshold condition is met, remove the first occurrence time 9129 # from the time list, and move the window to the second occurrence time 9130 # time (if the list became empty after first element was removed , i.e. 9131 # the threshold is 0, move the window to current time) 9132 9133 shift @{$oper->{"Times"}}; 9134 9135 if (scalar(@{$oper->{"Times"}})) { 9136 $oper->{"Time"} = $oper->{"Times"}->[0]; 9137 } else { 9138 $oper->{"Time"} = $time; 9139 } 9140 } 9141 9142} 9143 9144 9145# Parameters: par1 - reference to the rule definition 9146# par2 - reference to the hash of match values 9147# par3 - name of the configuration file 9148# par4 - the number of the pattern that has produced the match 9149# Action: process the EventGroup rule after a match has been found 9150 9151sub process_eventgroup_rule { 9152 9153 my($rule, $subst, $conffile, $index) = @_; 9154 my($desc, $key, $time, $oper, $i, $egrpstring); 9155 my($initaction, $slideaction, $endaction, $countaction, $action); 9156 9157 $desc = $rule->{"Desc"}; 9158 if (scalar(%{$subst})) { subst_string($subst, $desc, '$'); } 9159 9160 $key = gen_key($conffile, $rule->{"ID"}, $desc); 9161 $time = time(); 9162 9163 # if there exists event correlation operation for the key and its window 9164 # has expired, slide the window forward or terminate the operation 9165 9166 if (exists($corr_list{$key}) && 9167 $time - $corr_list{$key}->{"Time"} > $corr_list{$key}->{"Window"}) { 9168 9169 $oper = $corr_list{$key}; 9170 9171 if (!exists($oper->{"SuppressMode"})) { 9172 9173 # if the operation is not in event suppressing mode, slide the window 9174 # forward; if no events remain in the window, terminate the operation 9175 9176 update_times_eg($oper, $time - $oper->{"Window"}); 9177 9178 if (!scalar(@{$oper->{"AllTimes"}})) { 9179 $oper->{"DeleteInProgress"} = 1; 9180 execute_actionlist($oper->{"EndAction"}, $desc); 9181 delete $corr_list{$key}; 9182 } else { 9183 execute_actionlist($oper->{"SlideAction"}, $desc); 9184 } 9185 9186 } else { 9187 9188 # if the operation is in event suppressing mode, terminate it 9189 9190 $oper->{"DeleteInProgress"} = 1; 9191 execute_actionlist($oper->{"EndAction"}, $desc); 9192 delete $corr_list{$key}; 9193 } 9194 } 9195 9196 # if there was no event correlation operation for the key when this 9197 # function was called (or the operation was terminated previously 9198 # within this function), start the new operation 9199 9200 if (!exists($corr_list{$key})) { 9201 9202 if (scalar(%{$subst})) { 9203 9204 if (exists($rule->{"InitActVolat"})) { 9205 $initaction = []; 9206 copy_actionlist($rule->{"InitAction"}, $initaction); 9207 subst_actionlist($subst, $initaction, '$'); 9208 } else { $initaction = $rule->{"InitAction"}; } 9209 9210 if (exists($rule->{"SlideActVolat"})) { 9211 $slideaction = []; 9212 copy_actionlist($rule->{"SlideAction"}, $slideaction); 9213 subst_actionlist($subst, $slideaction, '$'); 9214 } else { $slideaction = $rule->{"SlideAction"}; } 9215 9216 if (exists($rule->{"EndActVolat"})) { 9217 $endaction = []; 9218 copy_actionlist($rule->{"EndAction"}, $endaction); 9219 subst_actionlist($subst, $endaction, '$'); 9220 } else { $endaction = $rule->{"EndAction"}; } 9221 9222 if (exists($rule->{"ActVolat"})) { 9223 $action = []; 9224 copy_actionlist($rule->{"Action"}, $action); 9225 subst_actionlist($subst, $action, '$'); 9226 } else { $action = $rule->{"Action"}; } 9227 9228 } else { 9229 9230 $initaction = $rule->{"InitAction"}; 9231 $slideaction = $rule->{"SlideAction"}; 9232 $endaction = $rule->{"EndAction"}; 9233 $action = $rule->{"Action"}; 9234 } 9235 9236 $corr_list{$key} = { "StartTime" => $time, 9237 "Time" => $time, 9238 "Type" => $rule->{"Type"}, 9239 "File" => $conffile, 9240 "ID" => $rule->{"ID"}, 9241 "Window" => $rule->{"Window"}, 9242 "AllTimes" => [], 9243 "Desc" => $desc, 9244 "InitAction" => $initaction, 9245 "SlideAction" => $slideaction, 9246 "EndAction" => $endaction, 9247 "Action" => $action }; 9248 9249 for ($i = 0; $i < $rule->{"EventNumber"}; ++$i) { 9250 $corr_list{$key}->{"TimesList"}->[$i] = []; 9251 } 9252 9253 $corr_list{$key}->{"InitInProgress"} = 1; 9254 9255 execute_actionlist($initaction, $desc); 9256 9257 # if the init action terminated the operation, return 9258 if (!exists($corr_list{$key})) { return; } 9259 9260 delete $corr_list{$key}->{"InitInProgress"}; 9261 } 9262 9263 $oper = $corr_list{$key}; 9264 9265 # record data about the current event into occurrence time lists (done before count 9266 # action is executed, so that the action would see the current event in the window) 9267 9268 push @{$oper->{"AllTimes"}}, [$time, $index]; 9269 push @{$oper->{"TimesList"}->[$index]}, $time; 9270 9271 # execute count action for the given event type 9272 9273 if (scalar(%{$subst}) && exists($rule->{"CountActVolatList"}->{$index})) { 9274 $countaction = []; 9275 copy_actionlist($rule->{"CountActionList"}->[$index], $countaction); 9276 subst_actionlist($subst, $countaction, '$'); 9277 } else { $countaction = $rule->{"CountActionList"}->[$index]; } 9278 9279 execute_actionlist($countaction, $desc); 9280 9281 # if the count action terminated the operation, return 9282 if (!exists($corr_list{$key})) { return; } 9283 9284 # if the operation is in event suppressing mode, return 9285 if (exists($oper->{"SuppressMode"})) { return; } 9286 9287 # check threshold conditions for all event types - if for some event type 9288 # the number of events is below threshold, return 9289 9290 for ($i = 0; $i < $rule->{"EventNumber"}; ++$i) { 9291 if (scalar(@{$oper->{"TimesList"}->[$i]}) < 9292 $rule->{"ThresholdList"}->[$i]) { return; } 9293 } 9294 9295 # if event group pattern has been provided by the rule, create an event 9296 # group string and match it with event group pattern; if the pattern is 9297 # not matching, return 9298 9299 if (exists($rule->{"EGrpPattern"})) { 9300 9301 $egrpstring = join(" ", map { $_->[1] + 1 } @{$oper->{"AllTimes"}}); 9302 9303 if (!$matchegrpfunc[$rule->{"EGrpPatType"}]->($egrpstring, 9304 $rule->{"EGrpPattern"})) { 9305 return 0; 9306 } 9307 } 9308 9309 # if all threshold conditions are met, go to suppressing mode if specified by 9310 # the rule, and execute the rule action (if setwpos action gets executed for 9311 # the operation, it will appear in suppressing mode if specified by the rule) 9312 9313 if (!exists($rule->{"MultipleActions"})) { $oper->{"SuppressMode"} = 1; } 9314 9315 execute_actionlist($oper->{"Action"}, $desc); 9316 9317} 9318 9319 9320# Parameters: par1 - reference to the rule definition 9321# par2 - reference to the hash of match values 9322# par3 - name of the configuration file 9323# par4 - trace hash for detecting loops during recursive calls 9324# Action: process the Jump rule after a match has been found. If the 9325# processing of rule file sets referenced by Jump is terminated by 9326# the continue*=EndMatch statement, return 1, otherwise return 0. 9327 9328sub process_jump_rule { 9329 9330 my($rule, $subst, $conffile, $trace) = @_; 9331 my($cfsetlist, $cfset, $cf); 9332 9333 if (!exists($rule->{"CFSet"})) { return 0; } 9334 9335 if (!defined($trace)) { $trace = {}; } 9336 9337 if (!exists($rule->{"ConstSet"}) && scalar(%{$subst})) { 9338 $cfsetlist = [ @{$rule->{"CFSet"}} ]; 9339 subst_string($subst, @{$cfsetlist}, '$'); 9340 } else { 9341 $cfsetlist = $rule->{"CFSet"}; 9342 } 9343 9344 foreach $cfset (@{$cfsetlist}) { 9345 9346 if (exists($trace->{$cfset})) { 9347 log_msg(LOG_WARN, 9348 "Can't jump to fileset '$cfset' from $conffile, loop detected"); 9349 next; 9350 } 9351 9352 if (!exists($cfset2cfile{$cfset})) { 9353 log_msg(LOG_WARN, 9354 "Can't jump to fileset '$cfset' from $conffile, set does not exist"); 9355 next; 9356 } 9357 9358 # process the files in the set by calling process_rules() recursively; 9359 # the set name is recorded to %trace, in order to detect loops; 9360 # if the processing in the rule file set is terminated by the 9361 # continue*=EndMatch statement, end processing and return 1 9362 9363 $trace->{$cfset} = 1; 9364 9365 foreach $cf (@{$cfset2cfile{$cfset}}) { 9366 if (process_rules($cf, $trace)) { 9367 delete $trace->{$cfset}; 9368 return 1; 9369 } 9370 } 9371 9372 delete $trace->{$cfset}; 9373 } 9374 9375 return 0; 9376} 9377 9378 9379# Parameters: par1 - reference to the Pair* rule definition 9380# Action: search the event correlation operations associated with the Pair* 9381# rule par1 and check if there is a matching event for the current 9382# content of input buffer. If there were 1 or more matches found, 9383# return 1, otherwise return 0 9384 9385sub match_pair_operations { 9386 9387 my($rule) = $_[0]; 9388 my($ret, $key, $oper); 9389 my(%subst, @context2, @action2); 9390 9391 $ret = 0; # shows if matches were found 9392 9393 foreach $key (keys %{$rule->{"Operations"}}) { 9394 9395 # since operations might be cancelled by other operations in this loop, 9396 # check if operation with the given key still exists 9397 9398 if (!exists($rule->{"Operations"}->{$key})) { next; } 9399 $oper = $rule->{"Operations"}->{$key}; 9400 9401 # check if the rule context expression must be evaluated before 9402 # comparing input line(s) with the pattern 9403 9404 if (exists($rule->{"ContPreEval2"}) && 9405 !tval_context_expr($oper->{"Context2"})) { next; } 9406 9407 # check if last N lines of input buffer match the pattern specified 9408 # by operation; if the pattern returned any values, assign them to %subst, 9409 # otherwise leave %subst empty 9410 9411 if ($matchfunc[$rule->{"PatType2"}]->($rule->{"PatLines2"}, 9412 $oper->{"Pattern2"}, 9413 \%subst, $rule->{"VarMap2"})) { 9414 9415 # evaluate the context expression of the rule 9416 9417 if (scalar(@{$oper->{"Context2"}}) && 9418 !exists($rule->{"ContPreEval2"})) { 9419 9420 if (scalar(%subst) && exists($rule->{"ContVolat2"})) { 9421 copy_context($oper->{"Context2"}, \@context2); 9422 subst_context(\%subst, \@context2, '$'); 9423 if (!tval_context_expr(\@context2)) { next; } 9424 } else { 9425 if (!tval_context_expr($oper->{"Context2"})) { next; } 9426 } 9427 } 9428 9429 # if the operation type is Pair, execute the 2nd action if the 9430 # correlation window has not expired, and terminate the operation 9431 9432 if ($rule->{"Type"} == PAIR) { 9433 9434 if (!$oper->{"Window"} || 9435 time() - $oper->{"Time"} <= $oper->{"Window"}) { 9436 9437 $ret = 1; 9438 ++$rule->{"MatchCount"}; 9439 9440 if (scalar(%subst)) { 9441 9442 if (exists($rule->{"ActVolat2"})) { 9443 if (!exists($oper->{"Act2Copied"})) { 9444 copy_actionlist($rule->{"Action2"}, \@action2); 9445 $oper->{"Action2"} = \@action2; 9446 } 9447 subst_actionlist(\%subst, $oper->{"Action2"}, '$'); 9448 } 9449 subst_string(\%subst, $oper->{"Desc2"}, '$'); 9450 } 9451 9452 execute_actionlist($oper->{"Action2"}, $oper->{"Desc2"}); 9453 } 9454 9455 delete $corr_list{$key}; 9456 delete $rule->{"Operations"}->{$key}; 9457 } 9458 9459 # if the operation type is PairWithWindow, execute the 2nd action and 9460 # terminate the operation (note that the event correlation window is 9461 # not checked for the execution of the 1st action, in order to achieve 9462 # good event ordering - if the 1st action creates a synthetic event, 9463 # it would always appear after the current event) 9464 9465 elsif ($rule->{"Type"} == PAIR_W_WINDOW) { 9466 9467 $ret = 1; 9468 ++$rule->{"MatchCount"}; 9469 9470 if (scalar(%subst)) { 9471 9472 if (exists($rule->{"ActVolat2"})) { 9473 if (!exists($oper->{"Act2Copied"})) { 9474 copy_actionlist($rule->{"Action2"}, \@action2); 9475 $oper->{"Action2"} = \@action2; 9476 } 9477 subst_actionlist(\%subst, $oper->{"Action2"}, '$'); 9478 } 9479 subst_string(\%subst, $oper->{"Desc2"}, '$'); 9480 } 9481 9482 execute_actionlist($oper->{"Action2"}, $oper->{"Desc2"}); 9483 9484 delete $corr_list{$key}; 9485 delete $rule->{"Operations"}->{$key}; 9486 } 9487 } 9488 } 9489 9490 # if there were 1 or more matches found, return 1, otherwise return 0 9491 9492 return $ret; 9493 9494} 9495 9496 9497# Parameters: par1 - name of the configuration file 9498# par2 - rule index inside the configuration file 9499# par3 - trace hash for detecting loops during recursive calls 9500# (this parameter is needed for processing Jump rules) 9501# Action: match the par2-th rule from the file par1 against input, and 9502# process the rule if match was found. 9503# The function returns the rule index in the configuration file 9504# where the processing should continue. 9505 9506sub match_1pattern_rule { 9507 9508 my($conffile, $index, $trace) = @_; 9509 my($rule, %subst, @context); 9510 9511 $rule = $configuration{$conffile}->[$index]; 9512 9513 # check if the rule context expression must be evaluated before 9514 # comparing input line(s) with the pattern; if the expression 9515 # evaluates FALSE, continue processing from the next rule 9516 9517 if (exists($rule->{"ContPreEval"}) && 9518 !tval_context_expr($rule->{"Context"})) { return $index+1; } 9519 9520 # check if last N lines of input buffer match the pattern specified 9521 # by rule; if the pattern returned any values, assign them to %subst, 9522 # otherwise leave %subst empty 9523 9524 if ($matchfunc[$rule->{"PatType"}]->($rule->{"PatLines"}, 9525 $rule->{"Pattern"}, 9526 \%subst, $rule->{"VarMap"})) { 9527 9528 # evaluate the context expression of the rule; if the expression 9529 # evaluates FALSE, continue processing from the next rule 9530 9531 if (scalar(@{$rule->{"Context"}}) && !exists($rule->{"ContPreEval"})) { 9532 9533 if (scalar(%subst) && exists($rule->{"ContVolat"})) { 9534 copy_context($rule->{"Context"}, \@context); 9535 subst_context(\%subst, \@context, '$'); 9536 if (!tval_context_expr(\@context)) { return $index+1; } 9537 } else { 9538 if (!tval_context_expr($rule->{"Context"})) { return $index+1; } 9539 } 9540 } 9541 9542 # increment the counter that reflects the rule usage 9543 ++$rule->{"MatchCount"}; 9544 9545 # process the rule (note that the GoTo field is set to $index+1 9546 # if continue=TakeNext; -1 if continue=EndMatch; "total number 9547 # of rules in the current configuration file" if continue=DontCont 9548 9549 # if rule is of type SUPPRESS, return immediately (note that 9550 # the GotoRule field is set to total number of rules in the current 9551 # configuration file which denotes end of processing for the file) 9552 9553 if ($rule->{"Type"} == SUPPRESS) { return $rule->{"GotoRule"}; } 9554 9555 # if rule is of type JUMP, process the rule with the extra $trace 9556 # parameter for detecting processing loops, and return the number of 9557 # the rule specified with continue; if during recursive processing 9558 # continue*=EndMatch statement was encountered, return -1 as if 9559 # continue=EndMatch for this Jump rule 9560 9561 if ($rule->{"Type"} == JUMP) { 9562 if ($processrulefunc[JUMP]->($rule, \%subst, $conffile, $trace)) { 9563 return -1; 9564 } else { 9565 return $rule->{"GotoRule"}; 9566 } 9567 } 9568 9569 # generic processing for other rule types 9570 9571 $processrulefunc[$rule->{"Type"}]->($rule, \%subst, $conffile); 9572 return $rule->{"GotoRule"}; 9573 9574 } 9575 9576 # if the pattern did not match, continue processing from the next rule 9577 return $index+1; 9578 9579} 9580 9581 9582# Parameters: par1 - name of the configuration file 9583# par2 - rule index inside the configuration file 9584# Action: match the par2-th rule from the file par1 against input, and 9585# process the rule if match was found. 9586# The function returns the rule index in the configuration file 9587# where the processing should continue. 9588 9589sub match_2pattern_rule { 9590 9591 my($conffile, $index) = @_; 9592 my($rule, %subst, @context); 9593 9594 $rule = $configuration{$conffile}->[$index]; 9595 9596 CHECK_1ST_PAT: { 9597 9598 # check if the rule context expression must be evaluated before comparing 9599 # input line(s) with the pattern; if the expression evaluates FALSE, 9600 # process event correlation operations associated with the rule and check 9601 # if their 2nd patterns match 9602 9603 if (exists($rule->{"ContPreEval"}) && 9604 !tval_context_expr($rule->{"Context"})) { last CHECK_1ST_PAT; } 9605 9606 # check if last N lines of input buffer match the pattern specified 9607 # by rule; if the pattern returned any values, assign them to %subst, 9608 # otherwise leave %subst empty 9609 9610 if ($matchfunc[$rule->{"PatType"}]->($rule->{"PatLines"}, 9611 $rule->{"Pattern"}, 9612 \%subst, $rule->{"VarMap"})) { 9613 9614 # evaluate the context expression of the rule; if the expression 9615 # evaluates FALSE, process event correlation operations associated 9616 # with the rule and check if their 2nd patterns match 9617 9618 if (scalar(@{$rule->{"Context"}}) && !exists($rule->{"ContPreEval"})) { 9619 9620 if (scalar(%subst) && exists($rule->{"ContVolat"})) { 9621 copy_context($rule->{"Context"}, \@context); 9622 subst_context(\%subst, \@context, '$'); 9623 if (!tval_context_expr(\@context)) { last CHECK_1ST_PAT; } 9624 } else { 9625 if (!tval_context_expr($rule->{"Context"})) { last CHECK_1ST_PAT; } 9626 } 9627 } 9628 9629 # increment the counter that reflects the rule usage 9630 ++$rule->{"MatchCount"}; 9631 9632 # process the rule 9633 $processrulefunc[$rule->{"Type"}]->($rule, \%subst, $conffile); 9634 9635 # return the number of the rule specified with continue (note that 9636 # for TakeNext the GotoRule field is set to $index+1, for DontCont 9637 # it is set to total number of rules in the file, while for EndMatch 9638 # it is set to -1) 9639 9640 return $rule->{"GotoRule"}; 9641 9642 } 9643 } # end of CHECK_1ST_PAT 9644 9645 # if the pattern did not match, process event correlation operations 9646 # associated with the rule and check if their 2nd patterns match 9647 9648 if (scalar(%{$rule->{"Operations"}}) && match_pair_operations($rule)) { 9649 return $rule->{"GotoRule2"}; 9650 } 9651 9652 # if there were no operations or no matching 2nd patterns, continue 9653 # processing from the next rule 9654 return $index+1; 9655 9656} 9657 9658 9659# Parameters: par1 - name of the configuration file 9660# par2 - rule index inside the configuration file 9661# Action: match the par2-th rule from the file par1 against input, and 9662# process the rule if match was found. 9663# The function returns the rule index in the configuration file 9664# where the processing should continue. 9665 9666sub match_eventgroup_rule { 9667 9668 my($conffile, $index) = @_; 9669 my($rule, $i, %subst, @context); 9670 9671 $rule = $configuration{$conffile}->[$index]; 9672 9673 for ($i = 0; $i < $rule->{"EventNumber"}; ++$i) { 9674 9675 # check if the rule context expression must be evaluated before 9676 # comparing input line(s) with the pattern; if the expression 9677 # evaluates FALSE, move to the next pattern 9678 9679 if (exists($rule->{"ContPreEvalList"}->{$i}) && 9680 !tval_context_expr($rule->{"ContextList"}->[$i])) { next; } 9681 9682 # check if last N lines of input buffer match the pattern specified 9683 # by rule; if the pattern returned any values, assign them to %subst, 9684 # otherwise leave %subst empty 9685 9686 if ($matchfunc[$rule->{"PatTypeList"}->[$i]]->( 9687 $rule->{"PatLinesList"}->[$i], 9688 $rule->{"PatternList"}->[$i], 9689 \%subst, 9690 $rule->{"VarMapList"}->[$i]) 9691 ) { 9692 9693 # evaluate the context expression of the rule; if the expression 9694 # evaluates FALSE, move to the next pattern 9695 9696 if (scalar(@{$rule->{"ContextList"}->[$i]}) && 9697 !exists($rule->{"ContPreEvalList"}->{$i})) { 9698 9699 if (scalar(%subst) && exists($rule->{"ContVolatList"}->{$i})) { 9700 copy_context($rule->{"ContextList"}->[$i], \@context); 9701 subst_context(\%subst, \@context, '$'); 9702 if (!tval_context_expr(\@context)) { next; } 9703 } else { 9704 if (!tval_context_expr($rule->{"ContextList"}->[$i])) { next; } 9705 } 9706 } 9707 9708 # increment the counter that reflects the rule usage 9709 ++$rule->{"MatchCount"}; 9710 9711 # process the rule 9712 $processrulefunc[EVENT_GROUP]->($rule, \%subst, $conffile, $i); 9713 9714 # return the number of the rule specified with continue for current 9715 # pattern (note that for TakeNext the GotoRule field is set to $index+1, 9716 # for DontCont it is set to total number of rules in the file, while 9717 # for EndMatch it is set to -1) 9718 9719 return $rule->{"GotoRuleList"}->[$i]; 9720 9721 } 9722 } 9723 9724 # if there was no matching pattern, continue processing from the next rule 9725 return $index+1; 9726 9727} 9728 9729 9730# Parameters: par1 - name of the configuration file 9731# par2 - trace hash for detecting loops during recursive calls 9732# Action: match the rules from configuration file par1 against the current 9733# content of input buffer. If during the matching continue*=EndMatch 9734# statement is encountered, return 1, otherwise return 0. 9735 9736sub process_rules { 9737 9738 my($conffile, $trace) = @_; 9739 my($i, $n, $rule, $cpu_total, $cpu_user, $cpu_sys); 9740 9741 $i = 0; 9742 $n = scalar(@{$configuration{$conffile}}); 9743 9744 # with --ruleperf option, collect CPU time data when rules are processed 9745 9746 if ($ruleperf) { 9747 9748 while ($i < $n) { 9749 9750 $rule = $configuration{$conffile}->[$i]; 9751 9752 # skip the CALENDAR rule 9753 if ($rule->{"Type"} == CALENDAR) { ++$i; next; } 9754 9755 # find CPU time of the process before the rule is processed 9756 9757 ($cpu_user, $cpu_sys) = times(); 9758 $cpu_total = $cpu_user + $cpu_sys; 9759 9760 # match the i-th rule against input 9761 $i = $matchrulefunc[$rule->{"Type"}]->($conffile, $i, $trace); 9762 9763 # find CPU time of the process after the rule has been processed 9764 # and calculate CPU time spent for processing the rule 9765 9766 ($cpu_user, $cpu_sys) = times(); 9767 $rule->{"CPUtime"} += $cpu_user + $cpu_sys - $cpu_total; 9768 9769 # increment the counter of total events processed by the rule 9770 ++$rule->{"EventCount"}; 9771 9772 # if the rule matching function returned -1 for the offset of 9773 # the next rule to be matched, terminate all matching and return 1 9774 9775 if ($i == -1) { return 1; } 9776 } 9777 9778 } else { 9779 9780 while ($i < $n) { 9781 9782 $rule = $configuration{$conffile}->[$i]; 9783 9784 # skip the CALENDAR rule 9785 if ($rule->{"Type"} == CALENDAR) { ++$i; next; } 9786 9787 # match the i-th rule against input 9788 $i = $matchrulefunc[$rule->{"Type"}]->($conffile, $i, $trace); 9789 9790 # if the rule matching function returned -1 for the offset of 9791 # the next rule to be matched, terminate all matching and return 1 9792 9793 if ($i == -1) { return 1; } 9794 } 9795 9796 } 9797 9798 return 0; 9799} 9800 9801 9802# Parameters: - 9803# Action: search lists %corr_list, %context_list, @calendar and 9804# @pending_events, performing timed tasks that are associated 9805# with elements and removing obsolete elements 9806 9807sub process_lists { 9808 9809 my($key, $rule, $oper); 9810 my($time, @time, $pevt, $event, $context, @buffer, $file, $peer); 9811 my($minute, $hour, $day, $month, $year, $weekday); 9812 my($lastdayofmonth, $shortyear, $cpu_total, $cpu_user, $cpu_sys); 9813 9814 # remove obsolete elements from %context_list 9815 9816 foreach $key (keys %context_list) { valid_context($key); } 9817 9818 # move pending events that have become relevant from 9819 # @pending_events list to @events list 9820 9821 if (scalar(@pending_events)) { 9822 9823 @buffer = (); 9824 $time = time(); 9825 9826 foreach $pevt (@pending_events) { 9827 if ($time >= $pevt->[0]) { 9828 $event = $pevt->[1]; 9829 $context = $pevt->[2]; 9830 log_msg(LOG_DEBUG, "Creating event '$event'"); 9831 push @events, $event, $context; 9832 } else { push @buffer, $pevt; } 9833 } 9834 9835 @pending_events = @buffer; 9836 } 9837 9838 # check the status of new connections over TCP and unix stream sockets 9839 # which are not yet established 9840 9841 if (scalar(%output_tcpconn)) { 9842 foreach $peer (keys %output_tcpconn) { 9843 check_new_conn(\%output_tcpconn, \%output_tcpsock, $peer, "TCP peer"); 9844 } 9845 } 9846 9847 if (scalar(%output_ustrconn)) { 9848 foreach $file (keys %output_ustrconn) { 9849 check_new_conn(\%output_ustrconn, \%output_ustream, $file, "socket"); 9850 } 9851 } 9852 9853 # detect established connections over TCP and unix stream sockets that 9854 # have been closed by peers or have errors, and close relevant sockets 9855 9856 if (scalar(%output_tcpsock)) { 9857 check_established_conns(\%output_tcpsock, "TCP peer"); 9858 } 9859 9860 if (scalar(%output_ustream)) { 9861 check_established_conns(\%output_ustream, "socket"); 9862 } 9863 9864 # process CALENDAR rules 9865 9866 @time = localtime(time()); 9867 $minute = $time[1]; 9868 $hour = $time[2]; 9869 $day = $time[3]; 9870 $month = $time[4]; 9871 $year = $time[5]; 9872 $weekday = $time[6]; 9873 9874 $lastdayofmonth = ((localtime(time()+86400))[3] == 1); 9875 $shortyear = $year % 100; 9876 9877 foreach $rule (@calendar) { 9878 9879 # if we have already executed an action in the current minute, skip 9880 9881 if ($minute == $rule->{"LastActionMinute"} && 9882 $hour == $rule->{"LastActionHour"} && 9883 $day == $rule->{"LastActionDay"} && 9884 $month == $rule->{"LastActionMonth"} && 9885 $year == $rule->{"LastActionYear"}) { next; } 9886 9887 # if one of the time conditions does not hold, skip 9888 9889 if (!exists($rule->{"Minutes"}->{$minute})) { next; } 9890 if (!exists($rule->{"Hours"}->{$hour})) { next; } 9891 9892 if (!exists($rule->{"Days"}->{$day}) && 9893 !($lastdayofmonth && exists($rule->{"Days"}->{"0"}))) { next; } 9894 9895 if (!exists($rule->{"Months"}->{$month})) { next; } 9896 if (!exists($rule->{"Weekdays"}->{$weekday})) { next; } 9897 if (!exists($rule->{"Years"}->{$shortyear})) { next; } 9898 9899 # with --ruleperf option, find process CPU time before rule is processed 9900 9901 if ($ruleperf) { 9902 ($cpu_user, $cpu_sys) = times(); 9903 $cpu_total = $cpu_user + $cpu_sys; 9904 } 9905 9906 # if the rule has no context expression, or the context expression 9907 # exists and evaluates true, execute the action list of the calendar 9908 # event and save current time 9909 9910 if (!scalar(@{$rule->{"Context"}}) || 9911 tval_context_expr($rule->{"Context"})) { 9912 9913 execute_actionlist($rule->{"Action"}, $rule->{"Desc"}); 9914 9915 $rule->{"LastActionMinute"} = $minute; 9916 $rule->{"LastActionHour"} = $hour; 9917 $rule->{"LastActionDay"} = $day; 9918 $rule->{"LastActionMonth"} = $month; 9919 $rule->{"LastActionYear"} = $year; 9920 9921 ++$rule->{"MatchCount"}; 9922 } 9923 9924 # with --ruleperf option, find process CPU time after rule has been 9925 # processed and calculate CPU time spent for processing the rule, 9926 # and increment the counter of total events processed by the rule 9927 9928 if ($ruleperf) { 9929 9930 ($cpu_user, $cpu_sys) = times(); 9931 $rule->{"CPUtime"} += $cpu_user + $cpu_sys - $cpu_total; 9932 9933 ++$rule->{"EventCount"}; 9934 } 9935 } 9936 9937 # accomplish clock-based tasks that are associated with elements of 9938 # %corr_list (event correlation operations) and remove obsolete elements 9939 9940 foreach $key (keys %corr_list) { 9941 9942 # since operations might be cancelled by other operations in this loop, 9943 # check if operation with the given key still exists 9944 9945 if (!exists($corr_list{$key})) { next; } 9946 9947 $oper = $corr_list{$key}; 9948 $time = time(); 9949 9950 # if the correlation window has not expired, move to next operation 9951 if ($time - $oper->{"Time"} <= $oper->{"Window"}) { next; } 9952 9953 $rule = $configuration{$oper->{"File"}}->[$oper->{"ID"}]; 9954 9955 # ------------------------------------------------------------ 9956 # SINGLE_W_SUPPRESS rule 9957 # ------------------------------------------------------------ 9958 9959 if ($oper->{"Type"} == SINGLE_W_SUPPRESS) { 9960 delete $corr_list{$key}; # terminate the operation 9961 } 9962 9963 # ------------------------------------------------------------ 9964 # PAIR rule 9965 # ------------------------------------------------------------ 9966 9967 elsif ($oper->{"Type"} == PAIR) { 9968 9969 # if the window is not set to infinity, terminate the operation 9970 9971 if ($oper->{"Window"}) { 9972 delete $corr_list{$key}; 9973 delete $rule->{"Operations"}->{$key}; 9974 } 9975 } 9976 9977 # ------------------------------------------------------------ 9978 # PAIR_W_WINDOW rule 9979 # ------------------------------------------------------------ 9980 9981 elsif ($oper->{"Type"} == PAIR_W_WINDOW) { 9982 9983 # execute the 1st action and terminate the operation 9984 9985 execute_actionlist($oper->{"Action"}, $oper->{"Desc"}); 9986 delete $corr_list{$key}; 9987 delete $rule->{"Operations"}->{$key}; 9988 } 9989 9990 # ------------------------------------------------------------ 9991 # SINGLE_W_THRESHOLD rule 9992 # ------------------------------------------------------------ 9993 9994 elsif ($oper->{"Type"} == SINGLE_W_THRESHOLD) { 9995 9996 if (!exists($oper->{"SuppressMode"})) { 9997 9998 # if the operation is not in suppress mode, slide the window forward; 9999 # if no events remain in the window, terminate the operation 10000 10001 update_times_swt($oper, $time - $oper->{"Window"}); 10002 if (!scalar(@{$oper->{"Times"}})) { delete $corr_list{$key}; } 10003 10004 } else { 10005 10006 # if the operation is in suppress mode, terminate it 10007 10008 execute_actionlist($oper->{"Action2"}, $oper->{"Desc"}); 10009 delete $corr_list{$key}; 10010 } 10011 } 10012 10013 # ------------------------------------------------------------ 10014 # SINGLE_W_2_THRESHOLDS rule 10015 # ------------------------------------------------------------ 10016 10017 elsif ($oper->{"Type"} == SINGLE_W_2_THRESHOLDS) { 10018 10019 if (!exists($oper->{"2ndPass"})) { 10020 10021 # if the operation is in rising threshold mode, slide the window 10022 # forward; if no events remain in the window, terminate the operation 10023 10024 update_times_swt($oper, $time - $oper->{"Window"}); 10025 if (!scalar(@{$oper->{"Times"}})) { delete $corr_list{$key}; } 10026 10027 } else { 10028 10029 # if the operation is in falling threshold mode, terminate it 10030 10031 execute_actionlist($oper->{"Action2"}, $oper->{"Desc2"}); 10032 delete $corr_list{$key}; 10033 } 10034 } 10035 10036 # ------------------------------------------------------------ 10037 # EVENT_GROUP rule 10038 # ------------------------------------------------------------ 10039 10040 elsif ($oper->{"Type"} == EVENT_GROUP) { 10041 10042 if (!exists($oper->{"SuppressMode"})) { 10043 10044 # if the operation is not in suppress mode, slide the window forward; 10045 # if no events remain in the window, terminate the operation 10046 10047 update_times_eg($oper, $time - $oper->{"Window"}); 10048 10049 if (!scalar(@{$oper->{"AllTimes"}})) { 10050 $oper->{"DeleteInProgress"} = 1; 10051 execute_actionlist($oper->{"EndAction"}, $oper->{"Desc"}); 10052 delete $corr_list{$key}; 10053 } else { 10054 execute_actionlist($oper->{"SlideAction"}, $oper->{"Desc"}); 10055 } 10056 10057 } else { 10058 10059 # if the operation window has expired and the operation is in 10060 # event suppressing mode, terminate it 10061 10062 $oper->{"DeleteInProgress"} = 1; 10063 execute_actionlist($oper->{"EndAction"}, $oper->{"Desc"}); 10064 delete $corr_list{$key}; 10065 } 10066 } 10067 10068 } 10069} 10070 10071 10072################################################# 10073# Functions related to reporting and data dumping 10074################################################# 10075 10076 10077# Parameters: par1 - reference to a action list 10078# Action: convert action list to a string representation 10079 10080sub actionlist2str { 10081 10082 my($actionlist) = $_[0]; 10083 my($i, $j); 10084 my($result); 10085 10086 $i = 0; 10087 $j = scalar(@{$actionlist}); 10088 $result = ""; 10089 10090 while ($i < $j) { 10091 10092 if ($actionlist->[$i] == NONE) { 10093 $result .= "none"; 10094 ++$i; 10095 } 10096 10097 elsif ($actionlist->[$i] == LOGONLY) { 10098 $result .= "logonly " . $actionlist->[$i+1]; 10099 $i += 2; 10100 } 10101 10102 elsif ($actionlist->[$i] == WRITE) { 10103 $result .= "write " . $actionlist->[$i+1] . " " . $actionlist->[$i+2]; 10104 $i += 3; 10105 } 10106 10107 elsif ($actionlist->[$i] == WRITEN) { 10108 $result .= "writen " . $actionlist->[$i+1] . " " . $actionlist->[$i+2]; 10109 $i += 3; 10110 } 10111 10112 elsif ($actionlist->[$i] == CLOSEF) { 10113 $result .= "closef " . $actionlist->[$i+1]; 10114 $i += 2; 10115 } 10116 10117 elsif ($actionlist->[$i] == OWRITECL) { 10118 $result .= "owritecl " . $actionlist->[$i+1] . " " . $actionlist->[$i+2]; 10119 $i += 3; 10120 } 10121 10122 elsif ($actionlist->[$i] == UDGRAM) { 10123 $result .= "udgram " . $actionlist->[$i+1] . " " . $actionlist->[$i+2]; 10124 $i += 3; 10125 } 10126 10127 elsif ($actionlist->[$i] == CLOSEUDGR) { 10128 $result .= "closeudgr " . $actionlist->[$i+1]; 10129 $i += 2; 10130 } 10131 10132 elsif ($actionlist->[$i] == USTREAM) { 10133 $result .= "ustream " . $actionlist->[$i+1] . " " . $actionlist->[$i+2]; 10134 $i += 3; 10135 } 10136 10137 elsif ($actionlist->[$i] == CLOSEUSTR) { 10138 $result .= "closeustr " . $actionlist->[$i+1]; 10139 $i += 2; 10140 } 10141 10142 elsif ($actionlist->[$i] == UDPSOCK) { 10143 $result .= "udpsock " . $actionlist->[$i+1] . " " . $actionlist->[$i+2]; 10144 $i += 3; 10145 } 10146 10147 elsif ($actionlist->[$i] == CLOSEUDP) { 10148 $result .= "closeudp " . $actionlist->[$i+1]; 10149 $i += 2; 10150 } 10151 10152 elsif ($actionlist->[$i] == TCPSOCK) { 10153 $result .= "tcpsock " . $actionlist->[$i+1] . " " . $actionlist->[$i+2]; 10154 $i += 3; 10155 } 10156 10157 elsif ($actionlist->[$i] == CLOSETCP) { 10158 $result .= "closetcp " . $actionlist->[$i+1]; 10159 $i += 2; 10160 } 10161 10162 elsif ($actionlist->[$i] == SHELLCOMMAND) { 10163 $result .= "shellcmd " . $actionlist->[$i+1]; 10164 $i += 2; 10165 } 10166 10167 elsif ($actionlist->[$i] == COMMANDEXEC) { 10168 $result .= "cmdexec " . join(" ", @{$actionlist->[$i+1]}); 10169 $i += 2; 10170 } 10171 10172 elsif ($actionlist->[$i] == SPAWN) { 10173 $result .= "spawn " . $actionlist->[$i+1]; 10174 $i += 2; 10175 } 10176 10177 elsif ($actionlist->[$i] == SPAWNEXEC) { 10178 $result .= "spawnexec " . join(" ", @{$actionlist->[$i+1]}); 10179 $i += 2; 10180 } 10181 10182 elsif ($actionlist->[$i] == CSPAWN) { 10183 $result .= "cspawn " . $actionlist->[$i+1] . " " . $actionlist->[$i+2]; 10184 $i += 3; 10185 } 10186 10187 elsif ($actionlist->[$i] == CSPAWNEXEC) { 10188 $result .= "cspawnexec " . $actionlist->[$i+1] 10189 . " " . join(" ", @{$actionlist->[$i+2]}); 10190 $i += 3; 10191 } 10192 10193 elsif ($actionlist->[$i] == PIPE) { 10194 $result .= "pipe " . $actionlist->[$i+1] . " " . $actionlist->[$i+2]; 10195 $i += 3; 10196 } 10197 10198 elsif ($actionlist->[$i] == PIPEEXEC) { 10199 $result .= "pipeexec " . $actionlist->[$i+1] 10200 . " " . join(" ", @{$actionlist->[$i+2]}); 10201 $i += 3; 10202 } 10203 10204 elsif ($actionlist->[$i] == CREATECONTEXT) { 10205 $result .= "create " . $actionlist->[$i+1] . " " . $actionlist->[$i+2]; 10206 if (scalar(@{$actionlist->[$i+3]})) { 10207 $result .= " (" . actionlist2str($actionlist->[$i+3]) . ")"; 10208 } 10209 $i += 4; 10210 } 10211 10212 elsif ($actionlist->[$i] == DELETECONTEXT) { 10213 $result .= "delete " . $actionlist->[$i+1]; 10214 $i += 2; 10215 } 10216 10217 elsif ($actionlist->[$i] == OBSOLETECONTEXT) { 10218 $result .= "obsolete " . $actionlist->[$i+1]; 10219 $i += 2; 10220 } 10221 10222 elsif ($actionlist->[$i] == SETCONTEXT) { 10223 $result .= "set " . $actionlist->[$i+1] . " " . $actionlist->[$i+2]; 10224 if (scalar(@{$actionlist->[$i+3]})) { 10225 $result .= " (" . actionlist2str($actionlist->[$i+3]) . ")"; 10226 } 10227 $i += 4; 10228 } 10229 10230 elsif ($actionlist->[$i] == ALIAS) { 10231 $result .= "alias " . $actionlist->[$i+1] . " " . $actionlist->[$i+2]; 10232 $i += 3; 10233 } 10234 10235 elsif ($actionlist->[$i] == UNALIAS) { 10236 $result .= "unalias " . $actionlist->[$i+1]; 10237 $i += 2; 10238 } 10239 10240 elsif ($actionlist->[$i] == ADD) { 10241 $result .= "add " . $actionlist->[$i+1] . " " . $actionlist->[$i+2]; 10242 $i += 3; 10243 } 10244 10245 elsif ($actionlist->[$i] == PREPEND) { 10246 $result .= "prepend " . $actionlist->[$i+1] . " " . $actionlist->[$i+2]; 10247 $i += 3; 10248 } 10249 10250 elsif ($actionlist->[$i] == FILL) { 10251 $result .= "fill " . $actionlist->[$i+1] . " " . $actionlist->[$i+2]; 10252 $i += 3; 10253 } 10254 10255 elsif ($actionlist->[$i] == REPORT) { 10256 $result .= "report " . $actionlist->[$i+1] . " " . $actionlist->[$i+2]; 10257 $i += 3; 10258 } 10259 10260 elsif ($actionlist->[$i] == REPORTEXEC) { 10261 $result .= "reportexec " . $actionlist->[$i+1] 10262 . " " . join(" ", @{$actionlist->[$i+2]}); 10263 $i += 3; 10264 } 10265 10266 elsif ($actionlist->[$i] == COPYCONTEXT) { 10267 $result .= "copy " . $actionlist->[$i+1] . " %" . $actionlist->[$i+2]; 10268 $i += 3; 10269 } 10270 10271 elsif ($actionlist->[$i] == EMPTYCONTEXT) { 10272 if (length($actionlist->[$i+2])) { 10273 $result .= "empty " . $actionlist->[$i+1] . " %" . $actionlist->[$i+2]; 10274 } else { 10275 $result .= "empty " . $actionlist->[$i+1]; 10276 } 10277 $i += 3; 10278 } 10279 10280 elsif ($actionlist->[$i] == POP) { 10281 $result .= "pop " . $actionlist->[$i+1] . " %" . $actionlist->[$i+2]; 10282 $i += 3; 10283 } 10284 10285 elsif ($actionlist->[$i] == SHIFT) { 10286 $result .= "shift " . $actionlist->[$i+1] . " %" . $actionlist->[$i+2]; 10287 $i += 3; 10288 } 10289 10290 elsif ($actionlist->[$i] == EXISTS) { 10291 $result .= "exists %" . $actionlist->[$i+1] . " " . $actionlist->[$i+2]; 10292 $i += 3; 10293 } 10294 10295 elsif ($actionlist->[$i] == GETSIZE) { 10296 $result .= "getsize %" . $actionlist->[$i+1] . " " . $actionlist->[$i+2]; 10297 $i += 3; 10298 } 10299 10300 elsif ($actionlist->[$i] == GETALIASES) { 10301 $result .= "getaliases %" . $actionlist->[$i+1] . " " . $actionlist->[$i+2]; 10302 $i += 3; 10303 } 10304 10305 elsif ($actionlist->[$i] == GETLIFETIME) { 10306 $result .= "getltime %" . $actionlist->[$i+1] . " " . $actionlist->[$i+2]; 10307 $i += 3; 10308 } 10309 10310 elsif ($actionlist->[$i] == SETLIFETIME) { 10311 $result .= "setltime " . $actionlist->[$i+1] . " " . $actionlist->[$i+2]; 10312 $i += 3; 10313 } 10314 10315 elsif ($actionlist->[$i] == GETCTIME) { 10316 $result .= "getctime %" . $actionlist->[$i+1] . " " . $actionlist->[$i+2]; 10317 $i += 3; 10318 } 10319 10320 elsif ($actionlist->[$i] == SETCTIME) { 10321 $result .= "setctime " . $actionlist->[$i+1] . " " . $actionlist->[$i+2]; 10322 $i += 3; 10323 } 10324 10325 elsif ($actionlist->[$i] == EVENT) { 10326 $result .= "event " . $actionlist->[$i+1] . " " . $actionlist->[$i+2]; 10327 $i += 3; 10328 } 10329 10330 elsif ($actionlist->[$i] == TEVENT) { 10331 $result .= "tevent " . $actionlist->[$i+1] . " " . $actionlist->[$i+2]; 10332 $i += 3; 10333 } 10334 10335 elsif ($actionlist->[$i] == CEVENT) { 10336 $result .= "cevent " . $actionlist->[$i+1] . " " 10337 . $actionlist->[$i+2] . " " . $actionlist->[$i+3]; 10338 $i += 4; 10339 } 10340 10341 elsif ($actionlist->[$i] == RESET) { 10342 $result .= "reset " . $actionlist->[$i+2] . " " . $actionlist->[$i+3]; 10343 $i += 4; 10344 } 10345 10346 elsif ($actionlist->[$i] == GETWINPOS) { 10347 $result .= "getwpos %" . $actionlist->[$i+1] . " " 10348 . $actionlist->[$i+3] . " " . $actionlist->[$i+4]; 10349 $i += 5; 10350 } 10351 10352 elsif ($actionlist->[$i] == SETWINPOS) { 10353 $result .= "setwpos " . $actionlist->[$i+1] . " " 10354 . $actionlist->[$i+3] . " " . $actionlist->[$i+4]; 10355 $i += 5; 10356 } 10357 10358 elsif ($actionlist->[$i] == ASSIGN) { 10359 $result .= "assign %" . $actionlist->[$i+1] . " " . $actionlist->[$i+2]; 10360 $i += 3; 10361 } 10362 10363 elsif ($actionlist->[$i] == ASSIGNSQ) { 10364 $result .= "assignsq %" . $actionlist->[$i+1] . " " . $actionlist->[$i+2]; 10365 $i += 3; 10366 } 10367 10368 elsif ($actionlist->[$i] == FREE) { 10369 $result .= "free %" . $actionlist->[$i+1]; 10370 $i += 2; 10371 } 10372 10373 elsif ($actionlist->[$i] == EVAL) { 10374 $result .= "eval %" . $actionlist->[$i+1] . " " . $actionlist->[$i+2]; 10375 $i += 3; 10376 } 10377 10378 elsif ($actionlist->[$i] == CALL) { 10379 $result .= "call %" . $actionlist->[$i+1] . " %" . $actionlist->[$i+2] 10380 . " " . join(" ", @{$actionlist->[$i+3]}); 10381 $i += 4; 10382 } 10383 10384 elsif ($actionlist->[$i] == LCALL) { 10385 $result .= "lcall %" . $actionlist->[$i+1] 10386 . " " . join(" ", @{$actionlist->[$i+3]}) . " "; 10387 if ($actionlist->[$i+4]) { $result .= ":>" } else { $result .= "->" } 10388 $result .= " " . $actionlist->[$i+2]; 10389 $i += 5; 10390 } 10391 10392 elsif ($actionlist->[$i] == REWRITE) { 10393 $result .= "rewrite " . $actionlist->[$i+1] . " " . $actionlist->[$i+2]; 10394 $i += 3; 10395 } 10396 10397 elsif ($actionlist->[$i] == ADDINPUT) { 10398 $result .= "addinput " . $actionlist->[$i+1] . " " . $actionlist->[$i+2] 10399 . " " . $actionlist->[$i+3]; 10400 $i += 4; 10401 } 10402 10403 elsif ($actionlist->[$i] == DROPINPUT) { 10404 $result .= "dropinput " . $actionlist->[$i+1]; 10405 $i += 2; 10406 } 10407 10408 elsif ($actionlist->[$i] == SIGEMUL) { 10409 $result .= "sigemul " . $actionlist->[$i+1]; 10410 $i += 2; 10411 } 10412 10413 elsif ($actionlist->[$i] == VARIABLESET) { 10414 $result .= "varset %" . $actionlist->[$i+1] . " " . $actionlist->[$i+2]; 10415 $i += 3; 10416 } 10417 10418 elsif ($actionlist->[$i] == IF) { 10419 $result .= "if %" . $actionlist->[$i+1] . " ("; 10420 if (scalar(@{$actionlist->[$i+2]})) { 10421 $result .= actionlist2str($actionlist->[$i+2]); 10422 } 10423 if (scalar(@{$actionlist->[$i+3]})) { 10424 $result .= ") else ("; 10425 $result .= actionlist2str($actionlist->[$i+3]); 10426 } 10427 $result .= ")"; 10428 $i += 4; 10429 } 10430 10431 elsif ($actionlist->[$i] == WHILE) { 10432 $result .= "while %" . $actionlist->[$i+1] . " ("; 10433 if (scalar(@{$actionlist->[$i+2]})) { 10434 $result .= actionlist2str($actionlist->[$i+2]); 10435 } 10436 $result .= ")"; 10437 $i += 3; 10438 } 10439 10440 elsif ($actionlist->[$i] == BREAK) { 10441 $result .= "break"; 10442 ++$i; 10443 } 10444 10445 elsif ($actionlist->[$i] == CONTINUE) { 10446 $result .= "continue"; 10447 ++$i; 10448 } 10449 10450 else { return "Unknown action type in the action list"; } 10451 10452 $result .= "; "; 10453 10454 } 10455 10456 return $result; 10457 10458} 10459 10460 10461# Parameters: par1 - pattern type 10462# par2 - pattern lines 10463# par3 - pattern 10464# Action: convert pattern to a printable representation 10465 10466sub pattern2str { 10467 10468 my($type, $lines, $pattern) = @_; 10469 10470 if ($type == SUBSTR) { 10471 return "substring for $lines line(s): $pattern"; 10472 } 10473 10474 elsif ($type == REGEXP) { 10475 return "regexp for $lines line(s): $pattern"; 10476 } 10477 10478 elsif ($type == PERLFUNC) { 10479 return "perlfunc for $lines line(s): $pattern"; 10480 } 10481 10482 elsif ($type == CACHED) { 10483 return "cached match: $pattern"; 10484 } 10485 10486 elsif ($type == NSUBSTR) { 10487 return "negative substring for $lines line(s): $pattern"; 10488 } 10489 10490 elsif ($type == NREGEXP) { 10491 return "negative regexp for $lines line(s): $pattern"; 10492 } 10493 10494 elsif ($type == NPERLFUNC) { 10495 return "negative perlfunc for $lines line(s): $pattern"; 10496 } 10497 10498 elsif ($type == NCACHED) { 10499 return "negative cached match: $pattern"; 10500 } 10501 10502 elsif ($type == TVALUE) { 10503 return "truth value: " . ($pattern?"TRUE":"FALSE"); 10504 } 10505 10506 else { return "Unknown pattern type"; } 10507 10508} 10509 10510 10511# Parameters: par1 - continue value 10512# par2 - rule number 10513# Action: convert continue parameters to a printable representation 10514 10515sub continue2str { 10516 10517 my($whatnext, $gotorule) = @_; 10518 10519 if ($whatnext == DONTCONT) { return "don't continue"; } 10520 elsif ($whatnext == TAKENEXT) { return "take next"; } 10521 elsif ($whatnext == GOTO) { return "goto rule " . ($gotorule + 1); } 10522 elsif ($whatnext == ENDMATCH) { return "end matching"; } 10523 else { return "Unknown continue value"; } 10524 10525} 10526 10527 10528# Parameters: par1 - reference to a context expression 10529# Action: convert given context to a printable representation 10530 10531sub context2str { 10532 10533 my($ref) = $_[0]; 10534 my($i, $j, $op1, $op2); 10535 my(@stack, $result); 10536 10537 $i = 0; 10538 $j = scalar(@{$ref}); 10539 @stack = (); 10540 10541 while ($i < $j) { 10542 10543 if ($ref->[$i] == EXPRESSION) { 10544 $op1 = $ref->[$i+1]; 10545 push @stack, "(" . context2str($op1) . ")"; 10546 $i += 2; 10547 } 10548 10549 elsif ($ref->[$i] == ECODE) { 10550 $op1 = $ref->[$i+1]; 10551 push @stack, "=( " . $op1 . " )"; 10552 $i += 2; 10553 } 10554 10555 elsif ($ref->[$i] == CCODE) { 10556 $op1 = $ref->[$i+1]; 10557 $op2 = $ref->[$i+2]; 10558 push @stack, join(" ", @{$op1}) . " -> $op2"; 10559 $i += 3; 10560 } 10561 10562 elsif ($ref->[$i] == CCODE2) { 10563 $op1 = $ref->[$i+1]; 10564 $op2 = $ref->[$i+2]; 10565 push @stack, join(" ", @{$op1}) . " :> $op2"; 10566 $i += 3; 10567 } 10568 10569 elsif ($ref->[$i] == VARSET) { 10570 $op1 = $ref->[$i+1]; 10571 push @stack, "varset $op1"; 10572 $i += 2; 10573 } 10574 10575 elsif ($ref->[$i] == OPERAND) { 10576 $op1 = $ref->[$i+1]; 10577 push @stack, $op1; 10578 $i += 2; 10579 } 10580 10581 elsif ($ref->[$i] == NEGATION) { 10582 $op1 = pop @stack; 10583 push @stack, "!" . $op1; 10584 ++$i; 10585 } 10586 10587 elsif ($ref->[$i] == AND) { 10588 $op2 = pop @stack; 10589 $op1 = pop @stack; 10590 push @stack, $op1 . " && " . $op2; 10591 ++$i; 10592 } 10593 10594 elsif ($ref->[$i] == OR) { 10595 $op2 = pop @stack; 10596 $op1 = pop @stack; 10597 push @stack, $op1 . " || " . $op2; 10598 ++$i; 10599 } 10600 10601 else { return "Unknown operator in the context expression"; } 10602 10603 } 10604 10605 $result = pop @stack; 10606 10607 if (!defined($result)) { $result = ""; } 10608 10609 return $result; 10610 10611} 10612 10613 10614# Parameters: par1 - filehandle 10615# par2 - key of event correlation operation 10616# par3 - reference to event correlation operation 10617# Action: print given event correlation operation to the filehandle 10618 10619sub print_operation { 10620 10621 my($handle, $key, $oper) = @_; 10622 my($rule, $conffile, $id, $time, $elem, $i, $j); 10623 10624 print $handle "Key: ", $key, "\n"; 10625 print $handle "Operation started at: ", 10626 scalar(localtime($oper->{"StartTime"})), "\n"; 10627 print $handle "Correlation window begins at: ", 10628 scalar(localtime($oper->{"Time"})), "\n"; 10629 10630 if ($oper->{"Window"}) { 10631 print $handle "Correlation window ends at: ", 10632 scalar(localtime($oper->{"Time"} + $oper->{"Window"})), "\n"; 10633 } 10634 10635 $conffile = $oper->{"File"}; 10636 $id = $oper->{"ID"}; 10637 $rule = $configuration{$conffile}->[$id]; 10638 10639 print $handle "Configuration file: ", $conffile, "\n"; 10640 print $handle "Rule number: ", $id+1, "\n"; 10641 print $handle "Rule internal ID: ", $id, "\n"; 10642 10643 if ($oper->{"Type"} == SINGLE_W_SUPPRESS) { 10644 10645 print $handle "Type: SingleWithSuppress\n"; 10646 10647 print $handle "Pattern: "; 10648 print $handle pattern2str($rule->{"PatType"}, 10649 $rule->{"PatLines"}, $rule->{"Pattern"}); 10650 print $handle "\n"; 10651 10652 print $handle "Context: "; 10653 print $handle context2str($rule->{"Context"}); 10654 print $handle "\n"; 10655 10656 print $handle "Behavior after match: "; 10657 print $handle continue2str($rule->{"WhatNext"}, $rule->{"GotoRule"}); 10658 print $handle "\n"; 10659 10660 print $handle "Description: ", $oper->{"Desc"}, "\n"; 10661 10662 print $handle "Action: "; 10663 print $handle actionlist2str($oper->{"Action"}); 10664 print $handle "\n"; 10665 10666 print $handle "Window: ", $rule->{"Window"}, " seconds\n"; 10667 10668 print $handle "\n"; 10669 10670 } 10671 10672 elsif ($oper->{"Type"} == PAIR) { 10673 10674 print $handle "Type: Pair\n"; 10675 10676 print $handle "Pattern: "; 10677 print $handle pattern2str($rule->{"PatType"}, 10678 $rule->{"PatLines"}, $rule->{"Pattern"}); 10679 print $handle "\n"; 10680 10681 print $handle "Context: "; 10682 print $handle context2str($rule->{"Context"}); 10683 print $handle "\n"; 10684 10685 print $handle "Behavior after match: "; 10686 print $handle continue2str($rule->{"WhatNext"}, $rule->{"GotoRule"}); 10687 print $handle "\n"; 10688 10689 print $handle "Description: ", $oper->{"Desc"}, "\n"; 10690 10691 print $handle "Action: "; 10692 print $handle actionlist2str($oper->{"Action"}); 10693 print $handle "\n"; 10694 10695 print $handle "Pattern2: "; 10696 print $handle pattern2str($rule->{"PatType2"}, 10697 $rule->{"PatLines2"}, $oper->{"Pattern2"}); 10698 print $handle "\n"; 10699 10700 print $handle "Context2: "; 10701 print $handle context2str($oper->{"Context2"}); 10702 print $handle "\n"; 10703 10704 print $handle "Behavior after match2: "; 10705 print $handle continue2str($rule->{"WhatNext2"}, $rule->{"GotoRule2"}); 10706 print $handle "\n"; 10707 10708 print $handle "Description2: ", $oper->{"Desc2"}, "\n"; 10709 10710 print $handle "Action2: "; 10711 print $handle actionlist2str($oper->{"Action2"}); 10712 print $handle "\n"; 10713 10714 if ($rule->{"Window"}) { 10715 print $handle "Window: ", $rule->{"Window"}, " seconds\n"; 10716 } else { 10717 print $handle "Window: infinite\n"; 10718 } 10719 10720 print $handle "\n"; 10721 10722 } 10723 10724 elsif ($oper->{"Type"} == PAIR_W_WINDOW) { 10725 10726 print $handle "Type: PairWithWindow\n"; 10727 10728 print $handle "Pattern: "; 10729 print $handle pattern2str($rule->{"PatType"}, 10730 $rule->{"PatLines"}, $rule->{"Pattern"}); 10731 print $handle "\n"; 10732 10733 print $handle "Context: "; 10734 print $handle context2str($rule->{"Context"}); 10735 print $handle "\n"; 10736 10737 print $handle "Behavior after match: "; 10738 print $handle continue2str($rule->{"WhatNext"}, $rule->{"GotoRule"}); 10739 print $handle "\n"; 10740 10741 print $handle "Description: ", $oper->{"Desc"}, "\n"; 10742 10743 print $handle "Action: "; 10744 print $handle actionlist2str($oper->{"Action"}); 10745 print $handle "\n"; 10746 10747 print $handle "Pattern2: "; 10748 print $handle pattern2str($rule->{"PatType2"}, 10749 $rule->{"PatLines2"}, $oper->{"Pattern2"}); 10750 print $handle "\n"; 10751 10752 print $handle "Context2: "; 10753 print $handle context2str($oper->{"Context2"}); 10754 print $handle "\n"; 10755 10756 print $handle "Behavior after match2: "; 10757 print $handle continue2str($rule->{"WhatNext2"}, $rule->{"GotoRule2"}); 10758 print $handle "\n"; 10759 10760 print $handle "Description2: ", $oper->{"Desc2"}, "\n"; 10761 10762 print $handle "Action2: "; 10763 print $handle actionlist2str($oper->{"Action2"}); 10764 print $handle "\n"; 10765 10766 print $handle "Window: ", $rule->{"Window"}, " seconds\n"; 10767 10768 print $handle "\n"; 10769 10770 } 10771 10772 elsif ($oper->{"Type"} == SINGLE_W_THRESHOLD) { 10773 10774 print $handle "Type: SingleWithThreshold\n"; 10775 10776 print $handle "Pattern: "; 10777 print $handle pattern2str($rule->{"PatType"}, 10778 $rule->{"PatLines"}, $rule->{"Pattern"}); 10779 print $handle "\n"; 10780 10781 print $handle "Context: "; 10782 print $handle context2str($rule->{"Context"}); 10783 print $handle "\n"; 10784 10785 print $handle "Behavior after match: "; 10786 print $handle continue2str($rule->{"WhatNext"}, $rule->{"GotoRule"}); 10787 print $handle "\n"; 10788 10789 print $handle "Description: ", $oper->{"Desc"}, "\n"; 10790 10791 print $handle "Action: "; 10792 print $handle actionlist2str($oper->{"Action"}); 10793 print $handle "\n"; 10794 10795 print $handle "Action2: "; 10796 print $handle actionlist2str($oper->{"Action2"}); 10797 print $handle "\n"; 10798 10799 print $handle "Window: ", $rule->{"Window"}, " seconds\n"; 10800 10801 print $handle "Threshold: ", $rule->{"Threshold"}, "\n"; 10802 10803 print $handle scalar(@{$oper->{"Times"}}), " events observed at "; 10804 10805 if (exists($oper->{"SuppressMode"})) { 10806 print $handle "(seen before threshold was crossed):\n"; 10807 } else { 10808 print $handle "(checking for threshold):\n"; 10809 } 10810 10811 foreach $time (@{$oper->{"Times"}}) 10812 { print $handle scalar(localtime($time)), "\n"; } 10813 10814 print $handle "\n"; 10815 10816 } 10817 10818 elsif ($oper->{"Type"} == SINGLE_W_2_THRESHOLDS) { 10819 10820 print $handle "Type: SingleWith2Thresholds\n"; 10821 10822 print $handle "Pattern: "; 10823 print $handle pattern2str($rule->{"PatType"}, 10824 $rule->{"PatLines"}, $rule->{"Pattern"}); 10825 print $handle "\n"; 10826 10827 print $handle "Context: "; 10828 print $handle context2str($rule->{"Context"}); 10829 print $handle "\n"; 10830 10831 print $handle "Behavior after match: "; 10832 print $handle continue2str($rule->{"WhatNext"}, $rule->{"GotoRule"}); 10833 print $handle "\n"; 10834 10835 print $handle "Description: ", $oper->{"Desc"}, "\n"; 10836 10837 print $handle "Action: "; 10838 print $handle actionlist2str($oper->{"Action"}); 10839 print $handle "\n"; 10840 10841 print $handle "Window: ", $rule->{"Window"}, " seconds\n"; 10842 10843 print $handle "Threshold: ", $rule->{"Threshold"}, "\n"; 10844 10845 print $handle "Description2: ", $oper->{"Desc2"}, "\n"; 10846 10847 print $handle "Action2: "; 10848 print $handle actionlist2str($oper->{"Action2"}); 10849 print $handle "\n"; 10850 10851 print $handle "Window2: ", $rule->{"Window2"}, " seconds\n"; 10852 10853 print $handle "Threshold2: ", $rule->{"Threshold2"}, "\n"; 10854 10855 print $handle scalar(@{$oper->{"Times"}}), " events observed at "; 10856 10857 if (exists($oper->{"2ndPass"})) { 10858 print $handle "(checking for 2nd threshold):\n"; 10859 } else { 10860 print $handle "(checking for 1st threshold):\n"; 10861 } 10862 10863 foreach $time (@{$oper->{"Times"}}) 10864 { print $handle scalar(localtime($time)), "\n"; } 10865 10866 print $handle "\n"; 10867 10868 } 10869 10870 elsif ($oper->{"Type"} == EVENT_GROUP) { 10871 10872 print $handle "Type: EventGroup", $rule->{"EventNumber"}, "\n"; 10873 10874 for ($i = 0; $i < $rule->{"EventNumber"}; ++$i) { 10875 10876 $j = ($i==0)?"":($i+1); 10877 10878 print $handle "Pattern$j: "; 10879 print $handle pattern2str($rule->{"PatTypeList"}->[$i], 10880 $rule->{"PatLinesList"}->[$i], 10881 $rule->{"PatternList"}->[$i]); 10882 print $handle "\n"; 10883 10884 print $handle "Context$j: "; 10885 print $handle context2str($rule->{"ContextList"}->[$i]); 10886 print $handle "\n"; 10887 10888 print $handle "Behavior after match$j: "; 10889 print $handle continue2str($rule->{"WhatNextList"}->[$i], 10890 $rule->{"GotoRuleList"}->[$i]); 10891 print $handle "\n"; 10892 10893 print $handle "Count action$j: "; 10894 print $handle actionlist2str($rule->{"CountActionList"}->[$i]); 10895 print $handle "\n"; 10896 10897 print $handle "Threshold$j: "; 10898 print $handle $rule->{"ThresholdList"}->[$i]; 10899 print $handle "\n"; 10900 } 10901 10902 if (exists($rule->{"EGrpPattern"})) { 10903 print $handle "Event group pattern: "; 10904 print $handle pattern2str($rule->{"EGrpPatType"}, 1, 10905 $rule->{"EGrpPattern"}); 10906 print $handle "\n"; 10907 } 10908 10909 print $handle "Init action: "; 10910 print $handle actionlist2str($oper->{"InitAction"}); 10911 print $handle "\n"; 10912 10913 print $handle "Slide action: "; 10914 print $handle actionlist2str($oper->{"SlideAction"}); 10915 print $handle "\n"; 10916 10917 print $handle "End action: "; 10918 print $handle actionlist2str($oper->{"EndAction"}); 10919 print $handle "\n"; 10920 10921 print $handle "Description: ", $oper->{"Desc"}, "\n"; 10922 10923 print $handle "Action: "; 10924 print $handle actionlist2str($oper->{"Action"}); 10925 print $handle "\n"; 10926 10927 print $handle "Window: ", $rule->{"Window"}, " seconds\n"; 10928 10929 print $handle scalar(@{$oper->{"AllTimes"}}), " events observed at "; 10930 10931 if (exists($oper->{"SuppressMode"})) { 10932 print $handle "(seen before thresholds were crossed):\n"; 10933 } else { 10934 print $handle "(checking for thresholds):\n"; 10935 } 10936 10937 foreach $elem (@{$oper->{"AllTimes"}}) { 10938 print $handle scalar(localtime($elem->[0])); 10939 print $handle " (matched by pattern #", $elem->[1]+1, ")"; 10940 print $handle "\n"; 10941 } 10942 10943 print $handle "\n"; 10944 10945 } 10946 10947 else { print $handle "Unknown operation type in the list\n\n"; } 10948 10949} 10950 10951 10952# Parameters: - 10953# Action: save some information about the current state of the program 10954# to dump file. 10955 10956sub dump_data { 10957 10958 my($dfilename, $dhandle, $i, $key, $ref, $file, $event, $fpos, @stat); 10959 my($time, $user, $system, $cuser, $csystem, $egid, @gidlist, %gids); 10960 my($len, $width1, $width2, $width3, $width4, $width5); 10961 my($name, %reported_names); 10962 10963 # get the current time 10964 10965 $time = time(); 10966 10967 # with --dumpfts command line option, include seconds since epoch 10968 # in the dump file name as a suffix 10969 10970 if ($dumpfts) { 10971 $dfilename = "$dumpfile.$time"; 10972 } else { 10973 $dfilename = $dumpfile; 10974 } 10975 10976 # verify that dumpfile does not exist and open it 10977 10978 if (-e $dfilename) { 10979 log_msg(LOG_WARN, "Can't write to dumpfile: $dfilename exists"); 10980 return; 10981 } 10982 10983 if (!open($dhandle, ">$dfilename")) { 10984 log_msg(LOG_ERR, "Can't open dumpfile $dfilename ($!)"); 10985 return; 10986 } 10987 10988 10989 # print program info 10990 10991 print $dhandle "Program information:\n"; 10992 print $dhandle '=' x 60, "\n"; 10993 10994 print $dhandle "Program version: ", $SEC_VERSION, "\n"; 10995 print $dhandle "Time of the start: ", 10996 scalar(localtime($startuptime)), "\n"; 10997 print $dhandle "Time of the last configuration load: ", 10998 scalar(localtime($lastconfigload)), "\n"; 10999 print $dhandle "Time of the dump: ", scalar(localtime($time)), "\n"; 11000 print $dhandle "Program resource file: ", $rcfile_status, "\n"; 11001 print $dhandle "Program options: ", $sec_options, "\n"; 11002 11003 # note that $) can report the same supplementary group ID more than once 11004 11005 @gidlist = split(' ', $) ); 11006 $egid = shift @gidlist; 11007 %gids = map { $_ => 1 } @gidlist; 11008 11009 print $dhandle "Effective user ID: ", $>, "\n"; 11010 print $dhandle "Effective group ID: ", $egid, "\n"; 11011 print $dhandle "Supplementary group IDs: ", join(" ", keys %gids), "\n"; 11012 11013 print $dhandle "\n"; 11014 11015 # print environment info 11016 11017 print $dhandle "Environment:\n"; 11018 print $dhandle '=' x 60, "\n"; 11019 11020 foreach $key (sort(keys %ENV)) { 11021 print $dhandle "$key=", $ENV{$key}, "\n"; 11022 } 11023 11024 print $dhandle "\n"; 11025 11026 # print performance statistics 11027 11028 print $dhandle "Performance statistics:\n"; 11029 print $dhandle '=' x 60, "\n"; 11030 11031 ($user, $system, $cuser, $csystem) = times(); 11032 11033 print $dhandle "Run time: ", $time - $startuptime, " seconds\n"; 11034 print $dhandle "User time: $user seconds\n"; 11035 print $dhandle "System time: $system seconds\n"; 11036 print $dhandle "Child user time: $cuser seconds\n"; 11037 print $dhandle "Child system time: $csystem seconds\n"; 11038 print $dhandle "Processed input lines: $processedlines\n"; 11039 11040 print $dhandle "\n"; 11041 11042 # print rule usage statistics 11043 11044 print $dhandle "Rule usage statistics:\n"; 11045 print $dhandle '=' x 60, "\n"; 11046 11047 foreach $file (@conffiles) { 11048 11049 print $dhandle "\nStatistics for the rules from $file\n"; 11050 print $dhandle "(loaded at ", 11051 scalar(localtime($config_ltimes{$file})), ")\n"; 11052 print $dhandle '-' x 60, "\n"; 11053 11054 $width1 = length(sprintf("%u", scalar(@{$configuration{$file}}))); 11055 $width2 = $width3 = 0; 11056 if ($ruleperf) { $width4 = $width5 = 0; } 11057 11058 foreach $ref (@{$configuration{$file}}) { 11059 $len = length(sprintf("%u", $ref->{"LineNo"})); 11060 if ($len > $width2) { $width2 = $len; } 11061 $len = length(sprintf("%u", $ref->{"MatchCount"})); 11062 if ($len > $width3) { $width3 = $len; } 11063 if ($ruleperf) { 11064 $len = length(sprintf("%.2f", $ref->{"CPUtime"})); 11065 if ($len > $width4) { $width4 = $len; } 11066 $len = length(sprintf("%u", $ref->{"EventCount"})); 11067 if ($len > $width5) { $width5 = $len; } 11068 } 11069 } 11070 11071 $i = 1; 11072 11073 foreach $ref (@{$configuration{$file}}) { 11074 printf $dhandle "Rule %*u line %*u matched %*u events", 11075 $width1, $i, $width2, $ref->{"LineNo"}, $width3, $ref->{"MatchCount"}; 11076 if ($ruleperf) { 11077 printf $dhandle 11078 ", %*.*f seconds of CPU time spent for processing %*u events", 11079 $width4, 2, $ref->{"CPUtime"}, $width5, $ref->{"EventCount"}; 11080 } 11081 print $dhandle " (", $ref->{"Desc"}, ")\n"; 11082 ++$i; 11083 } 11084 11085 } 11086 11087 print $dhandle "\n"; 11088 11089 # print input sources 11090 11091 print $dhandle "Input sources:\n"; 11092 print $dhandle '=' x 60, "\n"; 11093 11094 foreach $file (@inputfiles) { 11095 11096 print $dhandle $file, " "; 11097 11098 if ($inputsrc{$file}->{"open"}) { 11099 print $dhandle "(status: Open, "; 11100 if ($inputsrc{$file}->{"regfile"}) { 11101 $fpos = sysseek($inputsrc{$file}->{"fh"}, 0, SEEK_CUR); 11102 @stat = stat($inputsrc{$file}->{"fh"}); 11103 print $dhandle "type: regular file, "; 11104 # sysseek returns a string "0 but true" for offset 0, 11105 # so force numeric context by adding 0 11106 print $dhandle "read offset: ", defined($fpos)?$fpos+0:"undef", ", "; 11107 print $dhandle "file size: ", scalar(@stat)?$stat[7]:"undef"; 11108 } else { 11109 print $dhandle "type: pipe"; 11110 } 11111 print $dhandle ", "; 11112 print $dhandle "device/inode: ", $inputsrc{$file}->{"dev"}; 11113 print $dhandle "/", $inputsrc{$file}->{"inode"}, ", "; 11114 } else { 11115 print $dhandle "(status: Closed, "; 11116 } 11117 11118 print $dhandle "received data: ", 11119 $inputsrc{$file}->{"lines"}, " lines, "; 11120 11121 if ($intcontexts) { 11122 print $dhandle "context: ", $inputsrc{$file}->{"context"}; 11123 } else { 11124 print $dhandle "no context set"; 11125 } 11126 11127 print $dhandle ")\n"; 11128 11129 } 11130 11131 print $dhandle "\n"; 11132 11133 # print the content of input buffer(s) 11134 11135 if ($jointbuf) { 11136 11137 print $dhandle "Input buffering mode: "; 11138 print $dhandle "joint buffer for all input sources\n"; 11139 print $dhandle "Size of input buffer: $bufsize\n"; 11140 print $dhandle "\n"; 11141 11142 print $dhandle "Content of input buffer (last $bufsize input line(s)):\n"; 11143 print $dhandle '-' x 60, "\n"; 11144 11145 for ($i = $bufpos - $bufsize + 1; $i <= $bufpos; ++$i) { 11146 print $dhandle $input_buffer[$i], "\n"; 11147 } 11148 11149 print $dhandle '-' x 60, "\n"; 11150 print $dhandle "\n"; 11151 11152 print $dhandle "Last $bufsize input source(s):\n"; 11153 print $dhandle '-' x 60, "\n"; 11154 11155 for ($i = $bufpos - $bufsize + 1; $i <= $bufpos; ++$i) { 11156 if (defined($input_sources[$i])) { 11157 print $dhandle $input_sources[$i], "\n"; 11158 } else { 11159 print $dhandle "synthetic event\n"; 11160 } 11161 } 11162 11163 print $dhandle '-' x 60, "\n"; 11164 print $dhandle "\n"; 11165 11166 } else { 11167 11168 print $dhandle "Input buffering mode: "; 11169 print $dhandle "separate buffer for each input source\n"; 11170 print $dhandle "Size of each input buffer: $bufsize\n"; 11171 print $dhandle "\n"; 11172 11173 foreach $file (sort keys %input_buffers) { 11174 11175 print $dhandle "Content of input buffer for $file:\n"; 11176 print $dhandle '-' x 60, "\n"; 11177 11178 for ($i = $input_buffers{$file}->{"BufPos"} - $bufsize + 1; 11179 $i <= $input_buffers{$file}->{"BufPos"}; ++$i) { 11180 print $dhandle $input_buffers{$file}->{"Events"}->[$i], "\n"; 11181 } 11182 11183 print $dhandle '-' x 60, "\n"; 11184 print $dhandle "\n"; 11185 11186 } 11187 11188 print $dhandle "Content of input buffer for synthetic events:\n"; 11189 print $dhandle '-' x 60, "\n"; 11190 11191 for ($i = $event_buffer{"BufPos"} - $bufsize + 1; 11192 $i <= $event_buffer{"BufPos"}; ++$i) { 11193 print $dhandle $event_buffer{"Events"}->[$i], "\n"; 11194 } 11195 11196 print $dhandle '-' x 60, "\n"; 11197 print $dhandle "\n"; 11198 11199 } 11200 11201 # print the content of pending event buffer 11202 11203 $i = 0; 11204 print $dhandle "Pending events:\n"; 11205 print $dhandle '=' x 60, "\n"; 11206 11207 foreach $ref (@pending_events) { 11208 print $dhandle "Event: ", $ref->[1], "\n"; 11209 print $dhandle "Will be created at ", scalar(localtime($ref->[0])); 11210 if ($intcontexts) { print $dhandle " with context '", $ref->[2], "'"; } 11211 print $dhandle "\n\n"; 11212 ++$i; 11213 } 11214 11215 print $dhandle "Total: $i elements\n\n"; 11216 11217 # print the content of pattern match cache 11218 11219 $i = 0; 11220 print $dhandle "Pattern match cache:\n"; 11221 print $dhandle '=' x 60, "\n"; 11222 11223 while (($key, $ref) = each(%pmatch_cache)) { 11224 print $dhandle "Match: ", $key, "\n"; 11225 foreach $name (sort keys %{$ref}) { 11226 print $dhandle "$name = ", 11227 defined($ref->{$name})?$ref->{$name}:"undef", "\n"; 11228 } 11229 print $dhandle "\n"; 11230 ++$i; 11231 } 11232 11233 print $dhandle "Total: $i elements\n\n"; 11234 11235 # print the list of active event correlation operations 11236 11237 $i = 0; 11238 print $dhandle "List of event correlation operations:\n"; 11239 print $dhandle '=' x 60, "\n"; 11240 11241 while (($key, $ref) = each(%corr_list)) { 11242 print_operation($dhandle, $key, $ref); 11243 print $dhandle '-' x 60, "\n"; 11244 ++$i; 11245 } 11246 11247 print $dhandle "Total: $i elements\n\n"; 11248 11249 # print the list of active contexts 11250 11251 $i = 0; 11252 %reported_names = (); 11253 print $dhandle "List of contexts:\n"; 11254 print $dhandle '=' x 60, "\n"; 11255 11256 while (($key, $ref) = each(%context_list)) { 11257 11258 if (exists($reported_names{$key})) { next; } 11259 11260 foreach $name (keys %{$ref->{"Aliases"}}) { 11261 print $dhandle "Context Name: ", $name, "\n"; 11262 $reported_names{$name} = 1; 11263 } 11264 11265 print $dhandle "Creation Time: ", 11266 scalar(localtime($ref->{"Time"})), "\n"; 11267 11268 if ($ref->{"Window"}) { 11269 print $dhandle "Lifetime: ", $ref->{"Window"}, " seconds\n"; 11270 } else { 11271 print $dhandle "Lifetime: infinite\n"; 11272 } 11273 11274 if (scalar(@{$ref->{"Action"}})) { 11275 print $dhandle "Action on delete: ", 11276 actionlist2str($ref->{"Action"}); 11277 print $dhandle " (%s = ", $ref->{"Desc"}, ")\n"; 11278 } 11279 11280 if (scalar(@{$ref->{"Buffer"}})) { 11281 print $dhandle scalar(@{$ref->{"Buffer"}}), 11282 " events associated with context:\n"; 11283 foreach $event (@{$ref->{"Buffer"}}) 11284 { print $dhandle $event, "\n"; } 11285 } 11286 11287 print $dhandle '-' x 60, "\n"; 11288 ++$i; 11289 11290 } 11291 11292 print $dhandle "Total: $i elements\n\n"; 11293 11294 # print the list of running children 11295 11296 $i = 0; 11297 print $dhandle "Child processes:\n"; 11298 print $dhandle '=' x 60, "\n"; 11299 11300 while (($key, $ref) = each(%children)) { 11301 print $dhandle "Child PID: ", $key, "\n"; 11302 print $dhandle "Commandline started by child: ", $ref->{"cmd"}, "\n"; 11303 if ($ref->{"open"}) { 11304 print $dhandle "Connected to pipe input"; 11305 if ($intcontexts && exists($ref->{"context"})) 11306 { print $dhandle " with context '", $ref->{"context"}, "'"; } 11307 print $dhandle "\n"; 11308 } 11309 print $dhandle '-' x 60, "\n"; 11310 ++$i; 11311 } 11312 11313 print $dhandle "Total: $i elements\n\n"; 11314 11315 # print the values of action list variables 11316 11317 $i = 0; 11318 print $dhandle "Action list variables:\n"; 11319 print $dhandle '=' x 60, "\n"; 11320 11321 foreach $key (sort keys %variables) { 11322 if (defined($variables{$key})) { 11323 print $dhandle "%$key = '", $variables{$key}, "'\n"; 11324 } else { 11325 print $dhandle "%$key = undef\n"; 11326 } 11327 ++$i; 11328 } 11329 11330 print $dhandle "Total: $i elements\n\n"; 11331 11332 close($dhandle); 11333 11334 log_msg(LOG_DEBUG, "Dump to $dfilename completed"); 11335} 11336 11337 11338# Parameters: par1 - reference to hash where operation will be stored 11339# par2 - key of event correlation operation 11340# par3 - reference to event correlation operation 11341# Action: store given event correlation operation to the hash par1, so 11342# that it can be converted into JSON format (since perl is typeless 11343# language, numeric context is set for some fields by adding 0, in 11344# order to ensure their conversion into JSON numbers). 11345 11346sub convert_operation { 11347 11348 my($ref, $key, $oper) = @_; 11349 my($rule, $conffile, $id, $elem, $i, $j); 11350 11351 $ref->{"key"} = $key; 11352 $ref->{"starttime"} = $oper->{"StartTime"} + 0; 11353 $ref->{"windowstart"} = $oper->{"Time"} + 0; 11354 11355 if ($oper->{"Window"}) { 11356 $ref->{"windowend"} = $oper->{"Time"} + $oper->{"Window"}; 11357 } 11358 11359 $conffile = $oper->{"File"}; 11360 $id = $oper->{"ID"}; 11361 $rule = $configuration{$conffile}->[$id]; 11362 11363 $ref->{"configfile"} = $conffile; 11364 $ref->{"ruleid"} = $id + 0; 11365 11366 if ($oper->{"Type"} == SINGLE_W_SUPPRESS) { 11367 11368 $ref->{"type"} = "SingleWithSuppress"; 11369 11370 $ref->{"pattern"} = pattern2str($rule->{"PatType"}, 11371 $rule->{"PatLines"}, $rule->{"Pattern"}); 11372 11373 $ref->{"context"} = context2str($rule->{"Context"}); 11374 11375 $ref->{"continue"} = continue2str($rule->{"WhatNext"}, 11376 $rule->{"GotoRule"}); 11377 11378 $ref->{"desc"} = $oper->{"Desc"}; 11379 $ref->{"action"} = actionlist2str($oper->{"Action"}); 11380 11381 $ref->{"window"} = $rule->{"Window"} + 0; 11382 11383 } 11384 11385 elsif ($oper->{"Type"} == PAIR) { 11386 11387 $ref->{"type"} = "Pair"; 11388 11389 $ref->{"pattern"} = pattern2str($rule->{"PatType"}, 11390 $rule->{"PatLines"}, $rule->{"Pattern"}); 11391 11392 $ref->{"context"} = context2str($rule->{"Context"}); 11393 11394 $ref->{"continue"} = continue2str($rule->{"WhatNext"}, 11395 $rule->{"GotoRule"}); 11396 11397 $ref->{"desc"} = $oper->{"Desc"}; 11398 $ref->{"action"} = actionlist2str($oper->{"Action"}); 11399 11400 $ref->{"pattern2"} = pattern2str($rule->{"PatType2"}, 11401 $rule->{"PatLines2"}, $oper->{"Pattern2"}); 11402 11403 $ref->{"context2"} = context2str($oper->{"Context2"}); 11404 11405 $ref->{"continue2"} = continue2str($rule->{"WhatNext2"}, 11406 $rule->{"GotoRule2"}); 11407 11408 $ref->{"desc2"} = $oper->{"Desc2"}; 11409 $ref->{"action2"} = actionlist2str($oper->{"Action2"}); 11410 11411 $ref->{"window"} = $rule->{"Window"} + 0; 11412 11413 } 11414 11415 elsif ($oper->{"Type"} == PAIR_W_WINDOW) { 11416 11417 $ref->{"type"} = "PairWithWindow"; 11418 11419 $ref->{"pattern"} = pattern2str($rule->{"PatType"}, 11420 $rule->{"PatLines"}, $rule->{"Pattern"}); 11421 11422 $ref->{"context"} = context2str($rule->{"Context"}); 11423 11424 $ref->{"continue"} = continue2str($rule->{"WhatNext"}, 11425 $rule->{"GotoRule"}); 11426 11427 $ref->{"desc"} = $oper->{"Desc"}; 11428 $ref->{"action"} = actionlist2str($oper->{"Action"}); 11429 11430 $ref->{"pattern2"} = pattern2str($rule->{"PatType2"}, 11431 $rule->{"PatLines2"}, $oper->{"Pattern2"}); 11432 11433 $ref->{"context2"} = context2str($oper->{"Context2"}); 11434 11435 $ref->{"continue2"} = continue2str($rule->{"WhatNext2"}, 11436 $rule->{"GotoRule2"}); 11437 11438 $ref->{"desc2"} = $oper->{"Desc2"}; 11439 $ref->{"action2"} = actionlist2str($oper->{"Action2"}); 11440 11441 $ref->{"window"} = $rule->{"Window"} + 0; 11442 11443 } 11444 11445 elsif ($oper->{"Type"} == SINGLE_W_THRESHOLD) { 11446 11447 $ref->{"type"} = "SingleWithThreshold"; 11448 11449 $ref->{"pattern"} = pattern2str($rule->{"PatType"}, 11450 $rule->{"PatLines"}, $rule->{"Pattern"}); 11451 11452 $ref->{"context"} = context2str($rule->{"Context"}); 11453 11454 $ref->{"continue"} = continue2str($rule->{"WhatNext"}, 11455 $rule->{"GotoRule"}); 11456 11457 $ref->{"desc"} = $oper->{"Desc"}; 11458 $ref->{"action"} = actionlist2str($oper->{"Action"}); 11459 $ref->{"action2"} = actionlist2str($oper->{"Action2"}); 11460 11461 $ref->{"window"} = $rule->{"Window"} + 0; 11462 $ref->{"threshold"} = $rule->{"Threshold"} + 0; 11463 11464 if (exists($oper->{"SuppressMode"})) { 11465 $ref->{"status"} = "threshold reached"; 11466 } else { 11467 $ref->{"status"} = "checking for threshold"; 11468 } 11469 11470 $ref->{"eventtimes"} = []; 11471 11472 foreach $elem (@{$oper->{"Times"}}) { 11473 push @{$ref->{"eventtimes"}}, $elem + 0; 11474 } 11475 11476 } 11477 11478 elsif ($oper->{"Type"} == SINGLE_W_2_THRESHOLDS) { 11479 11480 $ref->{"type"} = "SingleWith2Thresholds"; 11481 11482 $ref->{"pattern"} = pattern2str($rule->{"PatType"}, 11483 $rule->{"PatLines"}, $rule->{"Pattern"}); 11484 11485 $ref->{"context"} = context2str($rule->{"Context"}); 11486 11487 $ref->{"continue"} = continue2str($rule->{"WhatNext"}, 11488 $rule->{"GotoRule"}); 11489 11490 $ref->{"desc"} = $oper->{"Desc"}; 11491 $ref->{"action"} = actionlist2str($oper->{"Action"}); 11492 11493 $ref->{"window"} = $rule->{"Window"} + 0; 11494 $ref->{"threshold"} = $rule->{"Threshold"} + 0; 11495 11496 $ref->{"desc2"} = $oper->{"Desc2"}; 11497 $ref->{"action2"} = actionlist2str($oper->{"Action2"}); 11498 11499 $ref->{"window2"} = $rule->{"Window2"} + 0; 11500 $ref->{"threshold2"} = $rule->{"Threshold2"} + 0; 11501 11502 if (exists($oper->{"2ndPass"})) { 11503 $ref->{"status"} = "checking for 2nd threshold"; 11504 } else { 11505 $ref->{"status"} = "checking for 1st threshold"; 11506 } 11507 11508 $ref->{"eventtimes"} = []; 11509 11510 foreach $elem (@{$oper->{"Times"}}) { 11511 push @{$ref->{"eventtimes"}}, $elem + 0; 11512 } 11513 11514 } 11515 11516 elsif ($oper->{"Type"} == EVENT_GROUP) { 11517 11518 $ref->{"type"} = "EventGroup" . $rule->{"EventNumber"}; 11519 11520 for ($i = 0; $i < $rule->{"EventNumber"}; ++$i) { 11521 11522 $j = ($i==0)?"":($i+1); 11523 11524 $ref->{"pattern$j"} = pattern2str($rule->{"PatTypeList"}->[$i], 11525 $rule->{"PatLinesList"}->[$i], 11526 $rule->{"PatternList"}->[$i]); 11527 11528 $ref->{"context$j"} = context2str($rule->{"ContextList"}->[$i]); 11529 11530 $ref->{"continue$j"} = continue2str($rule->{"WhatNextList"}->[$i], 11531 $rule->{"GotoRuleList"}->[$i]); 11532 11533 $ref->{"count$j"} = actionlist2str($rule->{"CountActionList"}->[$i]); 11534 11535 $ref->{"threshold$j"} = $rule->{"ThresholdList"}->[$i] + 0; 11536 } 11537 11538 if (exists($rule->{"EGrpPattern"})) { 11539 $ref->{"egpattern"} = pattern2str($rule->{"EGrpPatType"}, 1, 11540 $rule->{"EGrpPattern"}); 11541 } 11542 11543 $ref->{"init"} = actionlist2str($oper->{"InitAction"}); 11544 $ref->{"slide"} = actionlist2str($oper->{"SlideAction"}); 11545 $ref->{"end"} = actionlist2str($oper->{"EndAction"}); 11546 11547 $ref->{"desc"} = $oper->{"Desc"}; 11548 $ref->{"action"} = actionlist2str($oper->{"Action"}); 11549 11550 $ref->{"window"} = $rule->{"Window"} + 0; 11551 11552 if (exists($oper->{"SuppressMode"})) { 11553 $ref->{"status"} = "thresholds reached"; 11554 } else { 11555 $ref->{"status"} = "checking for thresholds"; 11556 } 11557 11558 $ref->{"eventtimes"} = []; 11559 $ref->{"eventpatterns"} = []; 11560 11561 foreach $elem (@{$oper->{"AllTimes"}}) { 11562 push @{$ref->{"eventtimes"}}, $elem->[0] + 0; 11563 push @{$ref->{"eventpatterns"}}, $elem->[1] + 1; 11564 } 11565 11566 } 11567 11568 else { $ref->{"status"} = "Unknown operation type in the list"; } 11569 11570} 11571 11572 11573# Parameters: - 11574# Action: save some information about the current state of the program 11575# to dump file in JSON format (since perl is typeless language, 11576# numeric context is set for some fields by adding 0, in order 11577# to ensure their conversion into JSON numbers). 11578 11579sub dump_data_json { 11580 11581 my($dfilename, $dhandle, $i, $key, $ref, $file, $fpos, @stat); 11582 my($time, $user, $system, $cuser, $csystem, $egid, @gidlist, %gids); 11583 my($name, %reported_names, %data, $json); 11584 11585 # get the current time 11586 11587 $time = time(); 11588 11589 # with --dumpfts command line option, include seconds since epoch 11590 # in the dump file name as a suffix 11591 11592 if ($dumpfts) { 11593 $dfilename = "$dumpfile.$time"; 11594 } else { 11595 $dfilename = $dumpfile; 11596 } 11597 11598 # verify that dumpfile does not exist and open it 11599 11600 if (-e $dfilename) { 11601 log_msg(LOG_WARN, "Can't write to dumpfile: $dfilename exists"); 11602 return; 11603 } 11604 11605 if (!open($dhandle, ">$dfilename")) { 11606 log_msg(LOG_ERR, "Can't open dumpfile $dfilename ($!)"); 11607 return; 11608 } 11609 11610 %data = (); 11611 11612 # program info 11613 11614 $data{"program"} = {}; 11615 11616 $data{"program"}->{"version"} = $SEC_VERSION; 11617 $data{"program"}->{"startuptime"} = $startuptime + 0; 11618 $data{"program"}->{"confloadtime"} = $lastconfigload + 0; 11619 $data{"program"}->{"dumptime"} = $time + 0; 11620 $data{"program"}->{"rcfile"} = $rcfile_status; 11621 $data{"program"}->{"options"} = $sec_options; 11622 11623 # note that $) can report the same supplementary group ID more than once 11624 11625 @gidlist = split(' ', $) ); 11626 $egid = shift @gidlist; 11627 %gids = map { $_ => 1 } @gidlist; 11628 11629 $data{"program"}->{"euid"} = $> + 0; 11630 $data{"program"}->{"egid"} = $egid + 0; 11631 $data{"program"}->{"sgid"} = [ map { $_ + 0 } keys %gids ]; 11632 11633 # environment info 11634 11635 $data{"env"} = \%ENV; 11636 11637 # performance statistics 11638 11639 $data{"perf"} = {}; 11640 11641 ($user, $system, $cuser, $csystem) = times(); 11642 11643 $data{"perf"}->{"runtime"} = $time - $startuptime; 11644 $data{"perf"}->{"user"} = $user + 0; 11645 $data{"perf"}->{"system"} = $system + 0; 11646 $data{"perf"}->{"childuser"} = $cuser + 0; 11647 $data{"perf"}->{"childsystem"} = $csystem + 0; 11648 $data{"perf"}->{"lines"} = $processedlines + 0; 11649 11650 # rule usage statistics 11651 11652 $data{"rulestats"} = {}; 11653 11654 foreach $file (@conffiles) { 11655 11656 $data{"rulestats"}->{$file} = {}; 11657 $data{"rulestats"}->{$file}->{"loadtime"} = $config_ltimes{$file} + 0; 11658 $data{"rulestats"}->{$file}->{"stats"} = []; 11659 11660 foreach $ref (@{$configuration{$file}}) { 11661 push @{$data{"rulestats"}->{$file}->{"stats"}}, 11662 { "ruleline" => $ref->{"LineNo"} + 0, 11663 "matches" => $ref->{"MatchCount"} + 0, 11664 "desc" => $ref->{"Desc"} }; 11665 if ($ruleperf) { 11666 $data{"rulestats"}->{$file}->{"stats"}->[-1]->{"events"} = 11667 $ref->{"EventCount"} + 0; 11668 $data{"rulestats"}->{$file}->{"stats"}->[-1]->{"cputime"} = 11669 $ref->{"CPUtime"} + 0; 11670 } 11671 } 11672 11673 } 11674 11675 # input sources 11676 11677 $data{"inputs"} = {}; 11678 11679 foreach $file (@inputfiles) { 11680 11681 $data{"inputs"}->{$file} = {}; 11682 $data{"inputs"}->{$file}->{"file"} = $file; 11683 11684 if ($inputsrc{$file}->{"open"}) { 11685 $data{"inputs"}->{$file}->{"status"} = "Open"; 11686 if ($inputsrc{$file}->{"regfile"}) { 11687 $fpos = sysseek($inputsrc{$file}->{"fh"}, 0, SEEK_CUR); 11688 @stat = stat($inputsrc{$file}->{"fh"}); 11689 $data{"inputs"}->{$file}->{"type"} = "regular file"; 11690 # sysseek returns a string "0 but true" for offset 0, 11691 # so force numeric context by adding 0 11692 if (defined($fpos)) { 11693 $data{"inputs"}->{$file}->{"offset"} = $fpos + 0; 11694 } 11695 if (scalar(@stat)) { 11696 $data{"inputs"}->{$file}->{"size"} = $stat[7] + 0; 11697 } 11698 } else { 11699 $data{"inputs"}->{$file}->{"type"} = "pipe"; 11700 } 11701 # in the case of stdin, dev and inode equal to string value "-" 11702 $data{"inputs"}->{$file}->{"dev"} = $inputsrc{$file}->{"dev"}; 11703 $data{"inputs"}->{$file}->{"inode"} = $inputsrc{$file}->{"inode"}; 11704 } else { 11705 $data{"inputs"}->{$file}->{"status"} = "Closed"; 11706 } 11707 11708 $data{"inputs"}->{$file}->{"lines"} = $inputsrc{$file}->{"lines"} + 0; 11709 11710 if ($intcontexts) { 11711 $data{"inputs"}->{$file}->{"context"} = $inputsrc{$file}->{"context"}; 11712 } 11713 11714 } 11715 11716 # content of input buffer(s) 11717 11718 $data{"buffer"} = {}; 11719 11720 if ($jointbuf) { 11721 11722 $data{"buffer"}->{"bufmode"} = "joint buffer for all input sources"; 11723 $data{"buffer"}->{"bufsize"} = $bufsize + 0; 11724 $data{"buffer"}->{"lastlines"} = []; 11725 $data{"buffer"}->{"lastinputs"} = []; 11726 11727 for ($i = $bufpos - $bufsize + 1; $i <= $bufpos; ++$i) { 11728 11729 push @{$data{"buffer"}->{"lastlines"}}, $input_buffer[$i]; 11730 11731 if (defined($input_sources[$i])) { 11732 push @{$data{"buffer"}->{"lastinputs"}}, $input_sources[$i]; 11733 } else { 11734 push @{$data{"buffer"}->{"lastinputs"}}, "synthetic event"; 11735 } 11736 } 11737 11738 } else { 11739 11740 $data{"buffer"}->{"bufmode"} = "separate buffer for each input source"; 11741 $data{"buffer"}->{"bufsize"} = $bufsize + 0; 11742 $data{"buffer"}->{"lastlines"} = {}; 11743 11744 foreach $file (keys %input_buffers) { 11745 11746 $data{"buffer"}->{"lastlines"}->{$file} = []; 11747 11748 for ($i = $input_buffers{$file}->{"BufPos"} - $bufsize + 1; 11749 $i <= $input_buffers{$file}->{"BufPos"}; ++$i) { 11750 push @{$data{"buffer"}->{"lastlines"}->{$file}}, 11751 $input_buffers{$file}->{"Events"}->[$i]; 11752 } 11753 } 11754 11755 $data{"buffer"}->{"lastsynevents"} = []; 11756 11757 for ($i = $event_buffer{"BufPos"} - $bufsize + 1; 11758 $i <= $event_buffer{"BufPos"}; ++$i) { 11759 push @{$data{"buffer"}->{"lastsynevents"}}, 11760 $event_buffer{"Events"}->[$i]; 11761 } 11762 } 11763 11764 # content of pending event buffer 11765 11766 $i = 0; 11767 $data{"pendingevents"} = []; 11768 11769 foreach $ref (@pending_events) { 11770 $data{"pendingevents"}->[$i] = {}; 11771 $data{"pendingevents"}->[$i]->{"event"} = $ref->[1]; 11772 $data{"pendingevents"}->[$i]->{"time"} = $ref->[0] + 0; 11773 if ($intcontexts) { 11774 $data{"pendingevents"}->[$i]->{"context"} = $ref->[2]; 11775 } 11776 ++$i; 11777 } 11778 11779 # content of pattern match cache 11780 11781 $data{"pmatchcache"} = \%pmatch_cache; 11782 11783 # list of active event correlation operations 11784 11785 $data{"operations"} = {}; 11786 11787 while (($key, $ref) = each(%corr_list)) { 11788 $data{"operations"}->{$key} = {}; 11789 convert_operation($data{"operations"}->{$key}, $key, $ref); 11790 } 11791 11792 # list of active contexts 11793 11794 $i = 0; 11795 %reported_names = (); 11796 $data{"contexts"} = []; 11797 11798 while (($key, $ref) = each(%context_list)) { 11799 11800 if (exists($reported_names{$key})) { next; } 11801 11802 $data{"contexts"}->[$i]->{"name"} = [ keys %{$ref->{"Aliases"}} ]; 11803 11804 foreach $name (keys %{$ref->{"Aliases"}}) { 11805 $reported_names{$name} = 1; 11806 } 11807 11808 $data{"contexts"}->[$i]->{"creationtime"} = $ref->{"Time"} + 0; 11809 $data{"contexts"}->[$i]->{"lifetime"} = $ref->{"Window"} + 0; 11810 11811 if (scalar(@{$ref->{"Action"}})) { 11812 $data{"contexts"}->[$i]->{"action"} = actionlist2str($ref->{"Action"}); 11813 } 11814 11815 $data{"contexts"}->[$i]->{"buffer"} = $ref->{"Buffer"}; 11816 11817 ++$i; 11818 } 11819 11820 # list of running children 11821 11822 $data{"children"} = {}; 11823 11824 while (($key, $ref) = each(%children)) { 11825 $data{"children"}->{$key} = {}; 11826 $data{"children"}->{$key}->{"pid"} = $key + 0; 11827 $data{"children"}->{$key}->{"cmdline"} = $ref->{"cmd"}; 11828 if ($ref->{"open"}) { 11829 $data{"children"}->{$key}->{"status"} = "Connected to pipe input"; 11830 if ($intcontexts && exists($ref->{"context"})) 11831 { $data{"children"}->{$key}->{"context"} = $ref->{"context"}; } 11832 } 11833 } 11834 11835 # values of action list variables 11836 11837 $data{"variables"} = \%variables; 11838 11839 # The 'allow_unknown' option will convert unexpected values 11840 # (such as code references held by action list variables) to json 11841 # null values (without this option encode() will croak). Also, 11842 # the 'utf8' option will generate json in utf8 format. 11843 11844 $json = eval { JSON::PP->new->utf8->allow_unknown->encode(\%data) }; 11845 11846 if ($@) { 11847 log_msg(LOG_ERR, "Can't create JSON data for dumpfile ($@)"); 11848 close($dhandle); 11849 return; 11850 } 11851 11852 if (defined($json)) { print $dhandle $json; } 11853 11854 close($dhandle); 11855 11856 log_msg(LOG_DEBUG, "Dump to $dfilename completed"); 11857} 11858 11859 11860############################################################## 11861# Functions related to IO handling and input buffer management 11862############################################################## 11863 11864 11865# Parameters: par1 - reference to input buffer 11866# par2 - read-write pointer of input buffer 11867# Action: if the input buffer contains no data, initialize it; 11868# if its size has changed, rearrange buffer data and return 11869# the new read-write pointer 11870 11871sub arrange_input_buffer { 11872 11873 my($buffer, $bufptr) = @_; 11874 my($cursize, $i, $diff); 11875 11876 $cursize = scalar(@{$buffer}); 11877 11878 # if the buffer length is zero, it needs initialization 11879 11880 if ($cursize == 0) { 11881 for ($i = 0; $i < $bufsize; ++$i) { $buffer->[$i] = ""; } 11882 return $bufsize - 1; 11883 } 11884 11885 # if the buffer contains data and the buffer size has not changed, 11886 # leave the buffer intact 11887 11888 if ($cursize == $bufsize) { return $bufptr; } 11889 11890 # if the buffer size has increased or decreased, shift the elements 11891 # so that the earliest has index 0 and the latest (buffersize - 1) 11892 11893 @{$buffer} = @{$buffer}[$bufptr - $cursize + 1 .. $bufptr]; 11894 11895 # if the buffer size has decreased by K, remove K earliest elements; 11896 # if the buffer size has increased by K, add K elements 11897 11898 if ($cursize > $bufsize) { 11899 $diff = $cursize - $bufsize; 11900 for ($i = 0; $i < $diff; ++$i) { shift @{$buffer}; } 11901 } else { 11902 $diff = $bufsize - $cursize; 11903 for ($i = 0; $i < $diff; ++$i) { unshift @{$buffer}, ""; } 11904 } 11905 11906 return $bufsize - 1; 11907 11908} 11909 11910 11911# Parameters: - 11912# Action: arrange all input buffers 11913 11914sub arrange_input_buffers { 11915 11916 my($inputfile); 11917 11918 # create or resize the main input buffer and the list of input sources 11919 # (they share a common read-write pointer, so it needs setting once) 11920 11921 arrange_input_buffer(\@input_buffer, $bufpos); 11922 $bufpos = arrange_input_buffer(\@input_sources, $bufpos); 11923 11924 # with --jointbuf command line option, run SEC with joint input buffer 11925 # for all input sources, otherwise set up separate buffers 11926 11927 if ($jointbuf) { 11928 11929 %input_buffers = (); 11930 %event_buffer = (); 11931 11932 } else { 11933 11934 # create or resize the input buffer for synthetic events 11935 11936 if (!exists($event_buffer{"BufPos"})) { 11937 $event_buffer{"Events"} = []; 11938 $event_buffer{"BufPos"} = 0; 11939 } 11940 11941 $event_buffer{"BufPos"} = 11942 arrange_input_buffer($event_buffer{"Events"}, $event_buffer{"BufPos"}); 11943 11944 # remove input buffers for sources which are no longer monitored 11945 11946 foreach $inputfile (keys %input_buffers) { 11947 if (!exists($inputsrc{$inputfile})) { delete $input_buffers{$inputfile}; } 11948 } 11949 11950 # create or resize the input buffer for each input source 11951 11952 foreach $inputfile (@inputfiles) { 11953 11954 if (!exists($input_buffers{$inputfile})) { 11955 $input_buffers{$inputfile} = {}; 11956 $input_buffers{$inputfile}->{"Events"} = []; 11957 $input_buffers{$inputfile}->{"BufPos"} = 0; 11958 } 11959 11960 $input_buffers{$inputfile}->{"BufPos"} = 11961 arrange_input_buffer($input_buffers{$inputfile}->{"Events"}, 11962 $input_buffers{$inputfile}->{"BufPos"}); 11963 } 11964 } 11965} 11966 11967 11968# Parameters: par1 - text of the SEC internal event 11969# Action: insert the SEC internal event par1 into the event buffer 11970# and match it against the rulebase. 11971 11972sub internal_event { 11973 11974 my($text) = $_[0]; 11975 my($conffile); 11976 11977 $intcontextname = SECEVENT_INT_CONTEXT; 11978 11979 log_msg(LOG_INFO, "Creating SEC internal context '$intcontextname'"); 11980 11981 $int_context->{"Aliases"}->{$intcontextname} = 1; 11982 $context_list{$intcontextname} = $int_context; 11983 11984 log_msg(LOG_INFO, "Creating SEC internal event '$text'"); 11985 11986 $bufpos = ($bufpos + 1) % $bufsize; 11987 $input_buffer[$bufpos] = $text; 11988 $input_sources[$bufpos] = undef; 11989 11990 if (!$jointbuf) { 11991 $event_buffer{"BufPos"} = ($event_buffer{"BufPos"} + 1) % $bufsize; 11992 $event_buffer{"Events"}->[$event_buffer{"BufPos"}] = $text; 11993 } 11994 11995 %pmatch_cache = (); 11996 11997 foreach $conffile (@maincfiles) { 11998 if (process_rules($conffile)) { last; } 11999 } 12000 12001 ++$processedlines; 12002 12003 log_msg(LOG_INFO, "Deleting SEC internal context '$intcontextname'"); 12004 12005 delete $context_list{$intcontextname}; 12006 delete $int_context->{"Aliases"}->{$intcontextname}; 12007 $intcontextname = undef; 12008 12009} 12010 12011 12012# Parameters: par1 - process ID 12013# par2 - 'read all' flag 12014# Action: read available data from the pipe of process par1 and create events 12015# from the data. If par2 is defined and non-zero, the function will 12016# keep reading until all available data have been consumed, otherwise 12017# the function will read once. The function will return the number 12018# bytes read from the pipe. 12019 12020sub consume_pipe { 12021 12022 my($pid, $read_all) = @_; 12023 my($rin, $ret, $pos, $nbytes, $total, $event); 12024 12025 $total = 0; 12026 12027 for (;;) { 12028 12029 # poll the pipe with select() 12030 12031 $rin = ''; 12032 vec($rin, fileno($children{$pid}->{"fh"}), 1) = 1; 12033 $ret = select($rin, undef, undef, 0); 12034 12035 # if select() failed because of the caught signal, try again, 12036 # otherwise close the pipe and quit the read-loop; 12037 # if select() returned 0, no data is available, so quit the read-loop 12038 12039 if (!defined($ret) || $ret < 0) { 12040 12041 if ($! == EINTR) { next; } 12042 12043 log_msg(LOG_ERR, 12044 "Process $pid pipe select error ($!), closing the pipe"); 12045 close($children{$pid}->{"fh"}); 12046 $children{$pid}->{"open"} = 0; 12047 last; 12048 12049 } elsif ($ret == 0) { last; } 12050 12051 # try to read from the pipe 12052 12053 $nbytes = sysread($children{$pid}->{"fh"}, 12054 $children{$pid}->{"buffer"}, 12055 $blocksize, length($children{$pid}->{"buffer"})); 12056 12057 # if sysread() failed and the reason was other than a caught signal, 12058 # close the pipe and quit the read-loop; 12059 # if sysread() failed because of a caught signal, continue (posix 12060 # allows read(2) to be interrupted by a signal and return -1, with 12061 # some bytes already been read into read buffer); 12062 # if sysread() returned 0, the other end has closed the pipe, so close 12063 # our end of the pipe and quit the read-loop 12064 12065 if (!defined($nbytes)) { 12066 12067 if ($! != EINTR) { 12068 12069 log_msg(LOG_ERR, "Process $pid pipe IO error ($!), closing the pipe"); 12070 close($children{$pid}->{"fh"}); 12071 $children{$pid}->{"open"} = 0; 12072 last; 12073 12074 } 12075 12076 } elsif ($nbytes == 0) { 12077 12078 close($children{$pid}->{"fh"}); 12079 $children{$pid}->{"open"} = 0; 12080 last; 12081 12082 } else { $total += $nbytes; } 12083 12084 # create all lines of pipe buffer as events, except the last one 12085 # which could be a partial line with its 2nd part still not written 12086 12087 for (;;) { 12088 12089 $pos = index($children{$pid}->{"buffer"}, "\n"); 12090 if ($pos == -1) { last; } 12091 12092 $event = substr($children{$pid}->{"buffer"}, 0, $pos); 12093 substr($children{$pid}->{"buffer"}, 0, $pos + 1) = ""; 12094 12095 log_msg(LOG_DEBUG, "Creating event '$event' (received from child $pid)"); 12096 push @events, $event, $children{$pid}->{"context"}; 12097 12098 } 12099 12100 if (!$read_all) { last; } 12101 12102 } 12103 12104 # if the child pipe has been closed but the pipe buffer still contains 12105 # data (bytes with no terminating newline), create an event from this data 12106 12107 if (!$children{$pid}->{"open"} && length($children{$pid}->{"buffer"})) { 12108 12109 $event = $children{$pid}->{"buffer"}; 12110 log_msg(LOG_DEBUG, "Creating event '$event' (received from child $pid)"); 12111 push @events, $event, $children{$pid}->{"context"}; 12112 12113 } 12114 12115 return $total; 12116 12117} 12118 12119 12120# Parameters: - 12121# Action: check the status of SEC child processes, and read their standard 12122# output if the event buffer is empty (unprocessed data from an exited 12123# process will be appended to the event buffer unconditionally). 12124# If at least one child process returns some bytes, return 1 (even 12125# if these bytes do not constitute a full line), otherwise return 0 12126 12127sub check_children { 12128 12129 my($pid, $exitcode, $newdata); 12130 12131 $newdata = 0; 12132 12133 # Check all child processes that have been started by '*spawn' actions 12134 # for input data. If the buffer of synthetic events is not empty, polling 12135 # of child processes is skipped. If new data from child standard output are 12136 # available through pipe, create synthetic events from the data (provided 12137 # that at least one complete line was read). If at least one child has 12138 # new data, raise the 'newdata' flag (even if incomplete line was read). 12139 12140 if (!scalar(@events)) { 12141 while ($pid = each(%children)) { 12142 if ($children{$pid}->{"open"} && consume_pipe($pid)) { $newdata = 1; } 12143 } 12144 } 12145 12146 # get the exit status of every terminated child process. 12147 12148 for (;;) { 12149 12150 # get the exit status of next terminated child process and 12151 # quit the loop if there are no more deceased children 12152 # waitpid will return -1 if there are no deceased children (or no 12153 # children at all) at the moment; on some platforms, 0 means that 12154 # there are children, but none of them is deceased at the moment. 12155 # Process ID can be a positive (UNIX) or negative (windows) integer. 12156 12157 $pid = waitpid(-1, WNOHANG); 12158 if ($pid == -1 || $pid == 0) { last; } 12159 12160 # check if the child process has really exited (and not just stopped). 12161 # This check will be skipped on Windows which does not have a valid 12162 # implementation of WIFEXITED macro. 12163 12164 if ($WIN32 || WIFEXITED($?) || WIFSIGNALED($?)) { 12165 12166 # find the child exit code 12167 12168 $exitcode = $? >> 8; 12169 12170 # if the terminated child was started with the '*spawn' action and 12171 # its pipe is still open, read all available data from the pipe 12172 12173 if ($children{$pid}->{"open"} && consume_pipe($pid, 1)) { $newdata = 1; } 12174 12175 # if the child exit code is zero and the child was started as 12176 # a part of SINGLE_W_SCRIPT rule, execute action list 'Action' 12177 12178 if (!$exitcode && defined($children{$pid}->{"Desc"})) { 12179 12180 log_msg(LOG_DEBUG, "Child $pid terminated with exitcode 0"); 12181 12182 execute_actionlist($children{$pid}->{"Action"}, 12183 $children{$pid}->{"Desc"}); 12184 12185 # if the child exit code is non-zero and the child was started as 12186 # a part of SINGLE_W_SCRIPT rule, execute action list 'Action2' 12187 12188 } elsif ($exitcode && defined($children{$pid}->{"Desc"})) { 12189 12190 log_msg(LOG_DEBUG, 12191 "Child $pid terminated with non-zero exitcode $exitcode"); 12192 12193 execute_actionlist($children{$pid}->{"Action2"}, 12194 $children{$pid}->{"Desc"}); 12195 12196 # if the child exit code is non-zero, log a message 12197 12198 } elsif ($exitcode) { 12199 log_msg(LOG_WARN, 12200 "Child $pid terminated with non-zero exitcode $exitcode (", 12201 $children{$pid}->{"cmd"}, ")"); 12202 } 12203 12204 delete $children{$pid}; 12205 12206 } 12207 12208 } 12209 12210 return $newdata; 12211 12212} 12213 12214 12215# Parameters: par1 - reference to the socket hash table 12216# par2 - textual peer type 12217# Action: Check established connections in table par1 that holds TCP or unix 12218# stream sockets, in order to detect connections that have been closed 12219# by remote peers or have errors. Textual peer type par2 is used in 12220# log messages about connections that are closed or have errors. 12221 12222sub check_established_conns { 12223 12224 my($sockets, $peertype) = @_; 12225 my($peer, $ret, $buffer, $nbytes, $total); 12226 12227 # communication errors with peers are logged at the debug level, 12228 # in order to prevent message floods with higher severity when large 12229 # amounts of data are transfered 12230 12231 foreach $peer (keys %{$sockets}) { 12232 12233 $total = 0; 12234 12235 for (;;) { 12236 12237 # check if socket is ready for reading; if no data are available 12238 # for reading, quit the read-loop 12239 12240 if (!socket_ready($sockets->{$peer}, 0)) { last; } 12241 12242 # if data are available, try to receive data from socket 12243 12244 $ret = recv($sockets->{$peer}, $buffer, $blocksize, 0); 12245 $nbytes = length($buffer); 12246 12247 # if recv() failed because of the caught signal, try polling and 12248 # receiving again; if recv() failed because of other error, close the 12249 # socket and quit the read-loop; if recv() returned 0, it indicates 12250 # EOF (connection has been closed), so close the socket; 12251 # otherwise stop receiving if more than threshold bytes have been read 12252 12253 if (!defined($ret)) { 12254 if ($! == EINTR) { next; } 12255 log_msg(LOG_DEBUG, "Connection error to $peertype '$peer' ($!)"); 12256 delete $sockets->{$peer}; 12257 last; 12258 } 12259 elsif ($nbytes == 0) { 12260 log_msg(LOG_DEBUG, "Connection to $peertype '$peer' closed by peer"); 12261 delete $sockets->{$peer}; 12262 last; 12263 } 12264 else { $total += $nbytes; } 12265 12266 if ($total >= BATCHREADLIMIT) { last; } 12267 } 12268 12269 } 12270} 12271 12272 12273# Parameters: par1 - name of the input file 12274# par2 - file offset 12275# Action: Input file will be opened and file offset will be moved to 12276# offset par2 (-1 means "seek EOF" and 0 means "don't seek at all"). 12277# Return the filehandle, device ID, inode number, and file type flag 12278# for the input file if open succeeded; otherwise return 'undef'. 12279 12280sub open_input_file { 12281 12282 my($file, $fpos) = @_; 12283 my($input, $flags, $regfile, @stat); 12284 12285 # if input is stdin, duplicate it 12286 12287 if ($file eq "-") { 12288 12289 if ($WIN32) { 12290 log_msg(LOG_ERR, "Stdin is not supported as input on Win32"); 12291 return undef; 12292 } 12293 12294 while (!open($input, "<&STDIN")) { 12295 if ($! == EINTR) { next; } 12296 log_msg(LOG_ERR, "Can't dup stdin ($!)"); 12297 return undef; 12298 } 12299 12300 } 12301 12302 # if input file is a regular file, open it for reading 12303 12304 elsif (-f $file) { 12305 12306 while (!sysopen($input, $file, O_RDONLY)) { 12307 if ($! == EINTR) { next; } 12308 log_msg(LOG_ERR, "Can't open input file $file ($!)"); 12309 return undef; 12310 } 12311 12312 } 12313 12314 # if input file is a named pipe, open it in the mode specified with 12315 # the -rwfifo option (read-write or read-only nonblocking) 12316 12317 elsif (-p $file) { 12318 12319 if ($WIN32) { 12320 log_msg(LOG_ERR, "Named pipe is not supported as input on Win32"); 12321 return undef; 12322 } 12323 12324 if ($rwfifo) { $flags = O_RDWR; } else { $flags = O_RDONLY | O_NONBLOCK; } 12325 12326 while (!sysopen($input, $file, $flags)) { 12327 if ($! == EINTR) { next; } 12328 log_msg(LOG_ERR, "Can't open input file $file ($!)"); 12329 return undef; 12330 } 12331 12332 } 12333 12334 # if input file does not exist, log a debug message if -reopen_timeout 12335 # option was given, otherwise log a warning message 12336 12337 elsif (! -e $file) { 12338 12339 if ($reopen_timeout) { 12340 log_msg(LOG_DEBUG, "Input file $file has not been created yet"); 12341 } else { 12342 log_msg(LOG_WARN, "Input file $file does not exist!"); 12343 } 12344 12345 return undef; 12346 12347 } 12348 12349 # input file is of unsupported type 12350 12351 else { 12352 log_msg(LOG_ERR, "Input file $file is of unsupported type!"); 12353 return undef; 12354 } 12355 12356 # if the input is not standard input, find the device id and inode number 12357 # for the opened filehandle 12358 12359 if ($file ne "-") { 12360 12361 for (;;) { 12362 @stat = stat($input); 12363 if (scalar(@stat)) { last; } 12364 if ($! == EINTR) { next; } 12365 log_msg(LOG_ERR, "Can't stat input file $file through filehandle ($!)"); 12366 close($input); 12367 return undef; 12368 } 12369 12370 } else { @stat = ("-", "-"); } 12371 12372 # If input filehandle is connected to a regular file, set the file type 12373 # flag to 1. Also, if $fpos == -1 or $fpos > 0, seek the given offset 12374 # in the file. If $fpos is greater than the file size, EOF will be seeked. 12375 12376 if (-f $input) { 12377 12378 if ($fpos > $stat[7]) { 12379 log_msg(LOG_NOTICE, 12380 "Offset $fpos beyond EOF, seeking EOF in input file $file"); 12381 $fpos = -1; 12382 } 12383 12384 if ($fpos == -1) { 12385 12386 while (!sysseek($input, 0, SEEK_END)) { 12387 if ($! == EINTR) { next; } 12388 log_msg(LOG_ERR, "Can't seek EOF in input file $file ($!)"); 12389 close($input); 12390 return undef; 12391 } 12392 12393 } elsif ($fpos > 0) { 12394 12395 while (!sysseek($input, $fpos, SEEK_SET)) { 12396 if ($! == EINTR) { next; } 12397 log_msg(LOG_ERR, "Can't seek offset $fpos in input file $file ($!)"); 12398 close($input); 12399 return undef; 12400 } 12401 12402 } 12403 12404 $regfile = 1; 12405 12406 } else { $regfile = 0; } 12407 12408 return ($input, $stat[0], $stat[1], $regfile); 12409 12410} 12411 12412 12413# Parameters: par1 - file offset 12414# par2 - flag (optional) 12415# Action: evaluate the inputfile patterns given in commandline, form the 12416# list of inputfiles and save it to global array @inputfiles. Each 12417# input file will then be opened and file offset will be moved to 12418# offset par1 (-1 means "seek EOF" and 0 means "don't seek at all"). 12419# If -intcontexts option is active, also set up internal contexts. 12420# If flag par2 is set, input files which are already open will not 12421# be closed and reopened, and their status data will be retained 12422# (par2 reflects the value of the -keepopen command line option) 12423 12424sub open_input { 12425 12426 my($fpos, $softopen) = @_; 12427 my($filepat, $pattern, $cmdline_context); 12428 my(%fcont, $inputfile, $time); 12429 my($fh, $dev, $inode, $regfile, $i, $j, @buf); 12430 12431 # If $softopen is set, status data of already open input files must be 12432 # retained and files must be kept open (note that $softopen reflects 12433 # the value of the -keepopen command line option) 12434 # In the case of full open, clean global arrays %inputsrc and @readbuffer 12435 # (the keys for %inputsrc are members of global array @inputfiles). 12436 # Note that dropping all data in %inputsrc will implicitly close all input 12437 # file handles. 12438 12439 if (!$softopen) { 12440 %inputsrc = (); 12441 @readbuffer = (); 12442 } 12443 12444 # Find the input file names and file contexts 12445 12446 %fcont = (); 12447 12448 foreach $filepat (@inputfilepat) { 12449 12450 # check if the input file pattern has a context associated with it, 12451 # and if it does, force the -intcontexts option 12452 12453 if ($filepat =~ /^(.+)=(\S+)$/) { 12454 $pattern = $1; 12455 $cmdline_context = $2; 12456 $intcontexts = 1; 12457 } else { 12458 $pattern = $filepat; 12459 $cmdline_context = undef; 12460 } 12461 12462 # interpret the pattern and store file-context pairs into %fcont 12463 # (if a file is given more than once in the command line, the last 12464 # definition will override previous ones) 12465 12466 foreach $inputfile (glob($pattern)) { 12467 $fcont{$inputfile} = defined($cmdline_context)?$cmdline_context: 12468 (FILEVENT_INT_CONTEXT_PREF . $inputfile); 12469 } 12470 12471 } 12472 12473 # Merge dynamic input files with input files provided in command line 12474 12475 foreach $inputfile (keys %dyninputfiles) { 12476 if (exists($fcont{$inputfile})) { 12477 log_msg(LOG_NOTICE, "Dynamic input file", $inputfile, 12478 "has been provided in command line and is no longer regarded dynamic"); 12479 delete $dyninputfiles{$inputfile}; 12480 } else { 12481 $fcont{$inputfile} = $dyninputfiles{$inputfile}; 12482 } 12483 } 12484 12485 # Open the input files 12486 12487 @inputfiles = sort keys %fcont; 12488 $time = time(); 12489 12490 foreach $inputfile (@inputfiles) { 12491 12492 log_msg(LOG_NOTICE, "Opening input file $inputfile"); 12493 12494 # in the case of soft open, check if we already have status data 12495 # for the input file in memory; if the file is open, update the file 12496 # context, but retain all other status data and skip the open 12497 12498 if ($softopen && exists($inputsrc{$inputfile}) && 12499 $inputsrc{$inputfile}->{"open"}) { 12500 log_msg(LOG_DEBUG, "Input file $inputfile already open"); 12501 $inputsrc{$inputfile}->{"context"} = $fcont{$inputfile}; 12502 next; 12503 } 12504 12505 # in all other cases reopen the input file and (re)initialize its 12506 # status data; note that if the file was previously open, recreating 12507 # its entry in %inputsrc will close the previous file handle implicitly, 12508 # since it is no longer referenced 12509 12510 ($fh, $dev, $inode, $regfile) = open_input_file($inputfile, $fpos); 12511 12512 $inputsrc{$inputfile} = { "fh" => $fh, 12513 "open" => defined($fh), 12514 "dev" => $dev, 12515 "inode" => $inode, 12516 "regfile" => $regfile, 12517 "buffer" => "", 12518 "scriptexec" => 0, 12519 "checktime" => 0, 12520 "lastopen" => $time, 12521 "lastread" => $time, 12522 "lines" => 0, 12523 "context" => $fcont{$inputfile} }; 12524 12525 # if the input file open failed because of the missing file, set the 12526 # "read_from_start" flag which enforces reading from the beginning 12527 # when the file will appear and another open will be attempted 12528 12529 if (!defined($fh) && $inputfile ne "-" && ! -e $inputfile) { 12530 $inputsrc{$inputfile}->{"read_from_start"} = 1; 12531 } 12532 12533 } 12534 12535 # In the case of soft open, delete %inputsrc and @readbuffer entries for 12536 # past input files which no longer match any input file pattern. 12537 # This step does not need to be carried out for full open, since %inputsrc 12538 # and @readbuffer are cleared before open. Note that deleting entries for 12539 # past input files will implicitly close all open file handles for them. 12540 12541 if ($softopen) { 12542 12543 foreach $inputfile (keys %inputsrc) { 12544 if (!exists($fcont{$inputfile})) { delete $inputsrc{$inputfile}; } 12545 } 12546 12547 @buf = (); 12548 $j = scalar(@readbuffer); 12549 12550 for ($i = 0; $i < $j; $i += 2) { 12551 if (!exists($fcont{$readbuffer[$i+1]})) { next; } 12552 push @buf, $readbuffer[$i], $readbuffer[$i+1]; 12553 } 12554 12555 @readbuffer = @buf; 12556 } 12557 12558} 12559 12560 12561# Parameters: par1 - name of the input file 12562# Action: check if input file has been removed, recreated or truncated. 12563# Return 1 if input file has changed and should be reopened; 12564# return 0 if the file has not changed or should not be 12565# reopened right now. If system call on the input file fails, 12566# close the file and return undef. 12567 12568sub input_shuffled { 12569 12570 my($file) = $_[0]; 12571 my(@stat, @stat2, $fpos, $bytes); 12572 12573 # standard input is always intact (it can't be recreated or truncated) 12574 12575 if ($file eq "-") { return 0; } 12576 12577 # stat the input file and return 0 if stat fails (e.g., input file has 12578 # been removed and not recreated yet, so we can't reopen it now) 12579 12580 @stat = stat($file); 12581 12582 if (!scalar(@stat)) { return 0; } 12583 12584 # if the input file is a regular file, get the current read offset 12585 12586 if ($inputsrc{$file}->{"regfile"}) { 12587 for (;;) { 12588 $fpos = sysseek($inputsrc{$file}->{"fh"}, 0, SEEK_CUR); 12589 if (defined($fpos)) { last; } 12590 if ($! == EINTR) { next; } 12591 log_msg(LOG_ERR, 12592 "Can't seek filehandle of input file $file ($!), closing the file"); 12593 close($inputsrc{$file}->{"fh"}); 12594 $inputsrc{$file}->{"open"} = 0; 12595 return undef; 12596 } 12597 } 12598 12599 # Check if device or inode numbers of filehandle and input file match 12600 # (this check will be skipped on Windows). If numbers don't match and 12601 # filehandle refers to a regular file, find the size of the file and if 12602 # read offset is smaller, read remaining bytes into file's IO buffer. 12603 12604 if (!$WIN32 && 12605 ($inputsrc{$file}->{"dev"} != $stat[0] || 12606 $inputsrc{$file}->{"inode"} != $stat[1])) { 12607 12608 if ($inputsrc{$file}->{"regfile"}) { 12609 12610 @stat2 = stat($inputsrc{$file}->{"fh"}); 12611 12612 if (scalar(@stat2)) { 12613 $bytes = $stat2[7] - $fpos; 12614 } else { 12615 $bytes = 0; 12616 } 12617 12618 if ($bytes > 0) { 12619 sysread($inputsrc{$file}->{"fh"}, $inputsrc{$file}->{"buffer"}, 12620 $bytes, length($inputsrc{$file}->{"buffer"})); 12621 } 12622 } 12623 12624 log_msg(LOG_NOTICE, "Input file $file has been recreated"); 12625 return 1; 12626 } 12627 12628 # If input file is a regular file, check if file size has decreased 12629 12630 if ($inputsrc{$file}->{"regfile"} && $fpos > $stat[7]) { 12631 log_msg(LOG_NOTICE, "Input file $file has been truncated"); 12632 return 1; 12633 } 12634 12635 return 0; 12636 12637} 12638 12639 12640# Parameters: par1 - name of the input file 12641# Action: read next line from the input file and return it (without '\n' at 12642# the end of the line). If the file has no complete line available, 12643# undef is returned. If read system call fails, or returns EOF and 12644# -notail mode is active, the file is closed and undef is returned. 12645 12646sub read_line_from_file { 12647 12648 my($file) = $_[0]; 12649 my($pos, $line, $rin, $ret, $nbytes); 12650 12651 # if there is a complete line in the read buffer of the file (i.e., the 12652 # read buffer contains at least one newline symbol), read line from there 12653 12654 $pos = index($inputsrc{$file}->{"buffer"}, "\n"); 12655 12656 if ($pos != -1) { 12657 $line = substr($inputsrc{$file}->{"buffer"}, 0, $pos); 12658 substr($inputsrc{$file}->{"buffer"}, 0, $pos + 1) = ""; 12659 return $line; 12660 } 12661 12662 if ($inputsrc{$file}->{"regfile"}) { 12663 12664 # try to read data from a regular file 12665 12666 $nbytes = sysread($inputsrc{$file}->{"fh"}, 12667 $inputsrc{$file}->{"buffer"}, 12668 $blocksize, length($inputsrc{$file}->{"buffer"})); 12669 12670 # check the exit value from sysread() that was saved to $nbytes: 12671 # if $nbytes == undef, sysread() failed; 12672 # if $nbytes == 0, we have reached EOF (no more data available); 12673 # otherwise ($nbytes > 0) sysread() succeeded 12674 12675 if (!defined($nbytes)) { 12676 12677 # check if sysread() failed because of the caught signal (posix 12678 # allows read(2) to be interrupted by a signal and return -1, with 12679 # some bytes already been read into read buffer); if sysread() failed 12680 # because of some other reason, close the file and return undef 12681 12682 if ($! != EINTR) { 12683 12684 log_msg(LOG_ERR, "Input file $file IO error ($!), closing the file"); 12685 12686 close($inputsrc{$file}->{"fh"}); 12687 $inputsrc{$file}->{"open"} = 0; 12688 12689 return undef; 12690 12691 } 12692 12693 } elsif ($nbytes == 0) { 12694 12695 # if we have reached EOF and -tail mode is set, return undef; if 12696 # -notail mode is active, close the file, and if the file buffer is not 12697 # empty, return its content (bytes between the last newline in the file 12698 # and EOF), otherwise return undef 12699 12700 if ($tail) { return undef; } 12701 12702 close($inputsrc{$file}->{"fh"}); 12703 $inputsrc{$file}->{"open"} = 0; 12704 12705 $line = $inputsrc{$file}->{"buffer"}; 12706 $inputsrc{$file}->{"buffer"} = ""; 12707 12708 if (length($line)) { return $line; } else { return undef; } 12709 12710 } 12711 12712 } else { 12713 12714 # poll the input pipe for new data with select(); if pipe contains 12715 # no data or polling yields an error, return undef 12716 12717 $rin = ''; 12718 vec($rin, fileno($inputsrc{$file}->{"fh"}), 1) = 1; 12719 $ret = select($rin, undef, undef, 0); 12720 12721 if (!defined($ret) || $ret < 0) { 12722 12723 # if select() failed because of the caught signal, return undef, 12724 # otherwise close the file and return undef 12725 12726 if ($! == EINTR) { return undef; } 12727 12728 log_msg(LOG_ERR, 12729 "Input pipe $file select error ($!), closing the pipe"); 12730 12731 close($inputsrc{$file}->{"fh"}); 12732 $inputsrc{$file}->{"open"} = 0; 12733 12734 return undef; 12735 12736 } elsif ($ret == 0) { return undef; } 12737 12738 # try to read from the pipe 12739 12740 $nbytes = sysread($inputsrc{$file}->{"fh"}, 12741 $inputsrc{$file}->{"buffer"}, 12742 $blocksize, length($inputsrc{$file}->{"buffer"})); 12743 12744 # check the exit value from sysread() that was saved to $nbytes: 12745 # if $nbytes == undef, sysread() failed; 12746 # if $nbytes == 0, we have reached EOF (no more data available); 12747 # otherwise ($nbytes > 0) sysread() succeeded 12748 12749 if (!defined($nbytes)) { 12750 12751 # check if sysread() failed because of the caught signal (posix 12752 # allows read(2) to be interrupted by a signal and return -1, with 12753 # some bytes already been read into read buffer); if sysread() failed 12754 # because of some other reason, log an error message and return undef 12755 12756 if ($! != EINTR) { 12757 12758 log_msg(LOG_ERR, "Input pipe $file IO error ($!), closing the pipe"); 12759 12760 close($inputsrc{$file}->{"fh"}); 12761 $inputsrc{$file}->{"open"} = 0; 12762 12763 return undef; 12764 12765 } 12766 12767 } elsif ($nbytes == 0) { 12768 12769 # If sysread() returns 0, there are no writers on the pipe anymore, 12770 # and from now on select() always claims that EOF is available for 12771 # reading (in -rwfifo mode, this should never happen for a named pipe, 12772 # since there is always at least one writer on the pipe). 12773 # If the pipe is a named pipe and -tail mode is active, reopen the pipe; 12774 # if the pipe represents standard input or -notail mode is active, close 12775 # the pipe. If the file buffer is not empty, return its content (bytes 12776 # between the last newline in the file and EOF), otherwise return undef. 12777 # Log messages about close and reopen at the debug level, in order to 12778 # prevent message floods when writer closes the pipe after each write. 12779 12780 log_msg(LOG_DEBUG, "No writers on input pipe $file, closing the pipe"); 12781 12782 close($inputsrc{$file}->{"fh"}); 12783 $inputsrc{$file}->{"open"} = 0; 12784 12785 if ($tail && $file ne "-") { 12786 12787 log_msg(LOG_DEBUG, "Reopening input pipe $file"); 12788 12789 ($inputsrc{$file}->{"fh"}, 12790 $inputsrc{$file}->{"dev"}, 12791 $inputsrc{$file}->{"inode"}, 12792 $inputsrc{$file}->{"regfile"}) = open_input_file($file, -1); 12793 12794 $inputsrc{$file}->{"open"} = defined($inputsrc{$file}->{"fh"}); 12795 if ($reopen_timeout) { $inputsrc{$file}->{"lastopen"} = time(); } 12796 12797 } 12798 12799 $line = $inputsrc{$file}->{"buffer"}; 12800 $inputsrc{$file}->{"buffer"} = ""; 12801 12802 if (length($line)) { return $line; } else { return undef; } 12803 12804 } 12805 12806 } 12807 12808 # if the read buffer contains a newline, cut the first line from the 12809 # read buffer and return it, otherwise return undef (even if there are 12810 # some bytes in the buffer) 12811 12812 $pos = index($inputsrc{$file}->{"buffer"}, "\n"); 12813 12814 if ($pos != -1) { 12815 $line = substr($inputsrc{$file}->{"buffer"}, 0, $pos); 12816 substr($inputsrc{$file}->{"buffer"}, 0, $pos + 1) = ""; 12817 return $line; 12818 } 12819 12820 return undef; 12821 12822} 12823 12824 12825# Parameters: par1 - variable where the input line is saved 12826# par2 - variable where the input file name is saved 12827# Action: attempt to read next line from each input file, and store the 12828# received lines with corresponding input file names to the read 12829# buffer. Return the first line from the read buffer, with par1 set 12830# to line and par2 set to file name. If there were no new lines in 12831# input files, par1 is set to undef but par2 reflects the status of 12832# input files: value 1 means that at least one of the input files has 12833# new data available (although no complete line), value 0 means that 12834# no data were added to any of the input files since the last poll. 12835 12836sub read_line { 12837 12838 my($line, $file); 12839 my($time, $len, $newdata); 12840 12841 # check all input files and store new data to the read buffer 12842 12843 $newdata = 0; 12844 $time = time(); 12845 12846 foreach $file (@inputfiles) { 12847 12848 # if the check timer for the file has not expired yet, skip the file 12849 12850 if ($check_timeout && $time < $inputsrc{$file}->{"checktime"}) { next; } 12851 12852 # before reading, memorize the number of bytes in the read cache 12853 12854 $len = length($inputsrc{$file}->{"buffer"}); 12855 12856 # if the input file is open, read a line from it; if the input file 12857 # is closed, treat it as an open file with no new data available 12858 12859 if ($inputsrc{$file}->{"open"}) { 12860 $line = read_line_from_file($file); 12861 } else { 12862 $line = undef; 12863 } 12864 12865 if (defined($line)) { 12866 12867 # if we received a new line, write the line to the read buffer; also 12868 # update time-related variables and call external script, if necessary 12869 12870 push @readbuffer, $line, $file; 12871 12872 if ($input_timeout) { $inputsrc{$file}->{"lastread"} = $time; } 12873 12874 if ($inputsrc{$file}->{"scriptexec"}) { 12875 12876 log_msg(LOG_INFO, 12877 "Input received, executing script $timeout_script 0 $file"); 12878 12879 exec_cmd([$timeout_script, 0, $file]); 12880 $inputsrc{$file}->{"scriptexec"} = 0; 12881 12882 } 12883 12884 } 12885 12886 else { 12887 12888 # if we were unable to obtain a complete line from the file but 12889 # new bytes were stored to the read cache, don't set the check 12890 # timer and skip shuffle and timeout checks 12891 12892 if ($len < length($inputsrc{$file}->{"buffer"})) { 12893 $newdata = 1; next; 12894 } 12895 12896 # if -check_timeout is set, poll the file after $check_timeout seconds 12897 12898 if ($check_timeout) { 12899 $inputsrc{$file}->{"checktime"} = $time + $check_timeout; 12900 } 12901 12902 # if we have waited for new bytes for more than $input_timeout 12903 # seconds, execute external script $timeout_script with commandline 12904 # parameters "1 <filename>" 12905 12906 if ($input_timeout && !$inputsrc{$file}->{"scriptexec"} && 12907 $time - $inputsrc{$file}->{"lastread"} >= $input_timeout) { 12908 12909 log_msg(LOG_INFO, 12910 "No input, executing script $timeout_script 1 $file"); 12911 12912 exec_cmd([$timeout_script, 1, $file]); 12913 $inputsrc{$file}->{"scriptexec"} = 1; 12914 12915 } 12916 12917 # if there were no new bytes in the input file and -notail mode 12918 # is active, skip shuffle and reopen timeout checks 12919 12920 if (!$tail) { next; } 12921 12922 # if there were no new bytes in the file and it has been shuffled, 12923 # reopen the file and start to process it from the beginning 12924 12925 if ($inputsrc{$file}->{"open"} && input_shuffled($file)) { 12926 12927 log_msg(LOG_NOTICE, "Reopening $file and processing from the start"); 12928 12929 close($inputsrc{$file}->{"fh"}); 12930 12931 ($inputsrc{$file}->{"fh"}, 12932 $inputsrc{$file}->{"dev"}, 12933 $inputsrc{$file}->{"inode"}, 12934 $inputsrc{$file}->{"regfile"}) = open_input_file($file, 0); 12935 12936 $inputsrc{$file}->{"open"} = defined($inputsrc{$file}->{"fh"}); 12937 12938 if ($reopen_timeout) { $inputsrc{$file}->{"lastopen"} = $time; } 12939 12940 } 12941 12942 # if we have waited for new bytes for more than $reopen_timeout 12943 # seconds, reopen the input file 12944 12945 if ($reopen_timeout && !$inputsrc{$file}->{"open"} && 12946 $time - $inputsrc{$file}->{"lastopen"} >= $reopen_timeout) { 12947 12948 log_msg(LOG_DEBUG, "Attempting to (re)open $file"); 12949 12950 if (exists($inputsrc{$file}->{"read_from_start"})) { 12951 12952 ($inputsrc{$file}->{"fh"}, 12953 $inputsrc{$file}->{"dev"}, 12954 $inputsrc{$file}->{"inode"}, 12955 $inputsrc{$file}->{"regfile"}) = open_input_file($file, 0); 12956 12957 if (defined($inputsrc{$file}->{"fh"})) { 12958 delete $inputsrc{$file}->{"read_from_start"}; 12959 } 12960 12961 } else { 12962 12963 ($inputsrc{$file}->{"fh"}, 12964 $inputsrc{$file}->{"dev"}, 12965 $inputsrc{$file}->{"inode"}, 12966 $inputsrc{$file}->{"regfile"}) = open_input_file($file, -1); 12967 12968 } 12969 12970 $inputsrc{$file}->{"open"} = defined($inputsrc{$file}->{"fh"}); 12971 $inputsrc{$file}->{"lastopen"} = $time; 12972 12973 } 12974 12975 } 12976 12977 } 12978 12979 # if we succeeded to read new data and write it to the read buffer, 12980 # return the first line from the buffer; otherwise return undef 12981 12982 if (scalar(@readbuffer)) { 12983 $_[0] = shift @readbuffer; 12984 $_[1] = shift @readbuffer; 12985 } else { 12986 $_[0] = undef; 12987 $_[1] = $newdata; 12988 } 12989 12990} 12991 12992 12993# Parameters: - 12994# Action: close all output files and sockets, and drop related data structures 12995# (dropping all filehandles from memory forces them to be closed) 12996 12997sub close_outputs { 12998 12999 %output_files = (); 13000 13001 %output_udgram = (); 13002 13003 %output_ustrconn = (); 13004 %output_ustream = (); 13005 13006 %output_udpsock = (); 13007 13008 %output_tcpconn = (); 13009 %output_tcpsock = (); 13010} 13011 13012 13013################################################### 13014# Functions related to signal reception and sending 13015################################################### 13016 13017 13018# Parameters: - 13019# Action: check whether signals have arrived and process them 13020 13021sub check_signals { 13022 13023 my($file, @file_list, @keys, $templevel); 13024 13025 # if SIGHUP has arrived, do a full restart of SEC 13026 13027 if ($refresh) { 13028 13029 log_msg(LOG_NOTICE, "SIGHUP received: full restart of SEC"); 13030 13031 # if -intevents flag was specified, generate the SEC_PRE_RESTART event 13032 13033 if ($intevents) { internal_event("SEC_PRE_RESTART"); } 13034 13035 # close all output files and sockets 13036 13037 close_outputs(); 13038 13039 # terminate child processes 13040 13041 if ($childterm) { child_cleanup(); } 13042 13043 # clear correlation operations, contexts and action list variables 13044 13045 %corr_list = (); 13046 %context_list = (); 13047 %variables = (); 13048 13049 # clear pending events 13050 13051 @pending_events = (); 13052 13053 # drop the names of dynamic input files (they will be closed when 13054 # open_input() is called later in this function) 13055 13056 %dyninputfiles = (); 13057 13058 # close the logfile and connection to the system logger 13059 13060 if ($logopen) { close($loghandle); $logopen = 0; } 13061 if ($syslogopen) { eval { Sys::Syslog::closelog() }; $syslogopen = 0; } 13062 13063 # re-read SEC command line and resource file options 13064 13065 read_options(); 13066 13067 # open the logfile and connection to the system logger 13068 13069 if (defined($logfile)) { open_logfile($logfile); } 13070 if (defined($syslogf)) { open_syslog($syslogf); } 13071 13072 # read configuration from SEC rule files 13073 13074 read_config(); 13075 13076 # if --bufsize command line option has not been provided or --bufsize=0, 13077 # set --bufsize by analyzing loaded rules 13078 13079 if (!$bufsize) { set_bufsize_option(); } 13080 13081 # (re)open all input sources and arrange input buffers 13082 13083 open_input(-1); 13084 arrange_input_buffers(); 13085 13086 # since all action list variables have been dropped, re-create builtin 13087 # action list variables for the current second and special characters 13088 13089 $timevar_update = time(); 13090 set_actionlist_time_var($timevar_update); 13091 set_actionlist_char_var(); 13092 13093 # if -intevents flag was specified, generate the SEC_RESTART event 13094 13095 if ($intevents) { internal_event("SEC_RESTART"); } 13096 13097 # set the signal flag back to zero 13098 13099 $refresh = 0; 13100 13101 } 13102 13103 # if SIGABRT has arrived, do a soft restart of SEC 13104 13105 if ($softrefresh) { 13106 13107 log_msg(LOG_NOTICE, "SIGABRT received: soft restart of SEC"); 13108 13109 # if -intevents flag was specified, generate the SEC_PRE_SOFTRESTART event 13110 13111 if ($intevents) { internal_event("SEC_PRE_SOFTRESTART"); } 13112 13113 # close all output files and sockets 13114 13115 close_outputs(); 13116 13117 # close the logfile and connection to the system logger 13118 13119 if ($logopen) { close($loghandle); $logopen = 0; } 13120 if ($syslogopen) { eval { Sys::Syslog::closelog() }; $syslogopen = 0; } 13121 13122 # re-read SEC command line and resource file options 13123 13124 read_options(); 13125 13126 # open the logfile and connection to the system logger 13127 13128 if (defined($logfile)) { open_logfile($logfile); } 13129 if (defined($syslogf)) { open_syslog($syslogf); } 13130 13131 # read configuration from SEC rule files that are either new or 13132 # have been modified, and store to the array @file_list the names 13133 # of files that have been modified or removed 13134 13135 soft_read_config(\@file_list); 13136 13137 # if --bufsize command line option has not been provided or --bufsize=0, 13138 # set --bufsize by analyzing loaded rules 13139 13140 if (!$bufsize) { set_bufsize_option(); } 13141 13142 # clear event correlation operations related to the modified and 13143 # removed configuration files 13144 13145 foreach $file (@file_list) { 13146 @keys = grep($corr_list{$_}->{"File"} eq $file, keys %corr_list); 13147 log_msg(LOG_DEBUG, 13148 "Terminating all event correlation operations started from $file,", 13149 "number of operations:", scalar(@keys)); 13150 delete @corr_list{@keys}; 13151 } 13152 13153 # if -keepopen flag was specified, close old and open new input sources, 13154 # otherwise (re)open all input sources; also, arrange input buffers 13155 13156 open_input(-1, $keepopen); 13157 arrange_input_buffers(); 13158 13159 # if -intevents flag was specified, generate the SEC_SOFTRESTART event 13160 13161 if ($intevents) { internal_event("SEC_SOFTRESTART"); } 13162 13163 # set the signal flag back to zero 13164 13165 $softrefresh = 0; 13166 13167 } 13168 13169 # if SIGUSR1 has arrived, create the dump file 13170 13171 if ($dumpdata) { 13172 13173 log_msg(LOG_NOTICE, "SIGUSR1 received: dumping performance and debug data"); 13174 13175 # write info about SEC state to the dump file 13176 13177 if ($dumpfjson) { dump_data_json(); } else { dump_data(); } 13178 13179 # set the signal flag back to zero 13180 13181 $dumpdata = 0; 13182 13183 } 13184 13185 # if SIGUSR2 has arrived, restart logging 13186 13187 if ($openlog) { 13188 13189 log_msg(LOG_NOTICE, 13190 "SIGUSR2 received: closing outputs and restarting logging"); 13191 13192 # if -intevents flag was specified, generate the SEC_PRE_LOGROTATE event 13193 13194 if ($intevents) { internal_event("SEC_PRE_LOGROTATE"); } 13195 13196 # close all output files and sockets 13197 13198 close_outputs(); 13199 13200 # reopen the logfile and connection to the system logger 13201 13202 if ($logopen) { close($loghandle); $logopen = 0; } 13203 if ($syslogopen) { eval { Sys::Syslog::closelog() }; $syslogopen = 0; } 13204 13205 if (defined($logfile)) { open_logfile($logfile); } 13206 if (defined($syslogf)) { open_syslog($syslogf); } 13207 13208 # if -intevents flag was specified, generate the SEC_LOGROTATE event 13209 13210 if ($intevents) { internal_event("SEC_LOGROTATE"); } 13211 13212 # set the signal flag back to zero 13213 13214 $openlog = 0; 13215 13216 } 13217 13218 # if SIGINT has arrived, set the debug level to a new value; also, log 13219 # a message without level, so that it would always appear in the log 13220 13221 if ($debuglevelinc) { 13222 13223 $templevel = ($debuglevel + $debuglevelinc - 1) % 6 + 1; 13224 13225 log_msg(LOG_WITHOUT_LEVEL, $debuglevelinc, "SIGINT signal(s) received:", 13226 "setting debuglevel from $debuglevel to $templevel"); 13227 13228 $debuglevel = $templevel; 13229 13230 # set the signal counter back to zero 13231 13232 $debuglevelinc = 0; 13233 13234 } 13235 13236 # if SIGTERM has arrived, shutdown SEC 13237 13238 if (exists($terminate{$$})) { 13239 13240 log_msg(LOG_NOTICE, "SIGTERM received: shutting down SEC"); 13241 13242 # If -intevents flag was specified, generate the SEC_SHUTDOWN event. 13243 # After generating SEC_SHUTDOWN event, SEC will sleep for TERMTIMEOUT 13244 # seconds, so that child processes that were triggered by SEC_SHUTDOWN 13245 # have time to create a signal handler for SIGTERM if they wish. 13246 13247 if ($intevents) { 13248 internal_event("SEC_SHUTDOWN"); 13249 if ($childterm) { sleep(TERMTIMEOUT); } 13250 } 13251 13252 # final shutdown procedures 13253 13254 if ($childterm) { child_cleanup(); } 13255 exit(0); 13256 13257 } 13258 13259} 13260 13261 13262# Parameters: - 13263# Action: detect if SIGINT can be used for changing logging levels 13264 13265sub override_sigint { 13266 13267 my($tty, $fh, $tcpgrp, $pgrp); 13268 13269 # if the process is started as a daemon, override SIGINT 13270 if ($detach) { return 1; } 13271 13272 # on Windows platform, do not override SIGINT 13273 if ($WIN32) { return 0; } 13274 13275 # if the process was not started as a daemon, get the name of the special 13276 # file which points to the controlling terminal of the process (should be 13277 # /dev/tty on most platforms); if opening the special file fails, the 13278 # process has no controlling terminal, and override SIGINT 13279 13280 $tty = POSIX::ctermid(); 13281 if (!open($fh, $tty)) { return 1; } 13282 13283 # get group ID of the current process, and the group ID of the foreground 13284 # process at the controlling terminal; if the ID's are different, current 13285 # process is not running on foreground, and override SIGINT 13286 13287 $pgrp = POSIX::getpgrp(); 13288 13289 if (!defined($pgrp)) { 13290 log_msg(LOG_ERR, "Can't get process group ID ($!)"); 13291 return 0; 13292 } 13293 13294 $tcpgrp = POSIX::tcgetpgrp(fileno($fh)); 13295 13296 if (!defined($tcpgrp)) { 13297 log_msg(LOG_ERR, "Can't get foreground process group ID ($!)"); 13298 return 0; 13299 } 13300 13301 close($fh); 13302 13303 return ($pgrp != $tcpgrp); 13304 13305} 13306 13307 13308# Parameters: - 13309# Action: terminate child processes 13310 13311sub child_cleanup { 13312 13313 my($pid, $p); 13314 13315 while($pid = each(%children)) { 13316 13317 $p = waitpid($pid, WNOHANG); 13318 13319 # exit status of a terminated process has been already fetched with waitpid(), 13320 # but the process is still present in the %children hash (should never happen) 13321 13322 if ($p == -1) { 13323 delete $children{$pid}; 13324 next; 13325 } 13326 13327 # according to the current call to waitpid(), the process has terminated 13328 13329 if ($p != 0 && ($WIN32 || WIFEXITED($?) || WIFSIGNALED($?))) { 13330 delete $children{$pid}; 13331 next; 13332 } 13333 13334 # the process is running 13335 13336 log_msg(LOG_NOTICE, "Sending SIGTERM to process $pid"); 13337 kill('TERM', $pid); 13338 } 13339 13340} 13341 13342 13343# Parameters: - 13344# Action: on arrival of SIGHUP set flag $refresh 13345 13346sub hup_handler { 13347 13348 $SIG{HUP} = \&hup_handler; 13349 $refresh = 1; 13350 $sigreceived = 1; 13351} 13352 13353 13354# Parameters: - 13355# Action: on arrival of SIGABRT set flag $softrefresh 13356 13357sub abrt_handler { 13358 13359 $SIG{ABRT} = \&abrt_handler; 13360 $softrefresh = 1; 13361 $sigreceived = 1; 13362} 13363 13364 13365# Parameters: - 13366# Action: on arrival of SIGUSR1 set flag $dumpdata 13367 13368sub usr1_handler { 13369 13370 $SIG{USR1} = \&usr1_handler; 13371 $dumpdata = 1; 13372 $sigreceived = 1; 13373} 13374 13375 13376# Parameters: - 13377# Action: on arrival of SIGUSR2 set flag $openlog 13378 13379sub usr2_handler { 13380 13381 $SIG{USR2} = \&usr2_handler; 13382 $openlog = 1; 13383 $sigreceived = 1; 13384} 13385 13386 13387# Parameters: - 13388# Action: on arrival of SIGINT set flag $debuglevelinc 13389 13390sub int_handler { 13391 13392 $SIG{INT} = \&int_handler; 13393 ++$debuglevelinc; 13394 $sigreceived = 1; 13395} 13396 13397 13398# Parameters: - 13399# Action: on arrival of SIGTERM set a flag for the current process ID 13400 13401sub term_handler { 13402 13403 $SIG{TERM} = \&term_handler; 13404 $terminate{$$} = 1; 13405 $sigreceived = 1; 13406} 13407 13408 13409######################################################## 13410# Functions related to daemonization, pid file creation, 13411# setting the user and group ID, and option processing 13412######################################################## 13413 13414 13415# Parameters: - 13416# Action: daemonize the process 13417 13418sub daemonize { 13419 13420 local $SIG{HUP} = 'IGNORE'; # ignore SIGHUP inside this function 13421 my($pid); 13422 13423 # -detach is not supported on Windows 13424 13425 if ($WIN32) { 13426 log_msg(LOG_CRIT, "'--detach' option is not supported on Win32"); 13427 exit(1); 13428 } 13429 13430 # if stdin was specified as input, we can't become a daemon 13431 13432 if (grep($_ eq "-", @inputfiles)) { 13433 log_msg(LOG_CRIT, 13434 "Can't become a daemon (stdin is specified as input), exiting!"); 13435 exit(1); 13436 } 13437 13438 # fork a new copy of the process and exit from the parent 13439 13440 $pid = fork(); 13441 13442 if (!defined($pid)) { 13443 log_msg(LOG_CRIT, 13444 "Can't fork a new process for daemonization ($!), exiting!"); 13445 exit(1); 13446 } 13447 13448 if ($pid) { exit(0); } 13449 13450 # create a new session and process group 13451 13452 if (!POSIX::setsid()) { 13453 log_msg(LOG_CRIT, "Can't start a new session ($!), exiting!"); 13454 exit(1); 13455 } 13456 13457 # fork a second copy of the process and exit from the parent - the parent 13458 # as a session leader might deliver the SIGHUP signal to child when it 13459 # exits, but SIGHUP is ignored inside this function 13460 13461 $pid = fork(); 13462 13463 if (!defined($pid)) { 13464 log_msg(LOG_CRIT, 13465 "Can't fork a new process for daemonization ($!), exiting!"); 13466 exit(1); 13467 } 13468 13469 if ($pid) { exit(0); } 13470 13471 # connect stdin, stdout, and stderr to /dev/null 13472 13473 if (!open(STDIN, '/dev/null')) { 13474 log_msg(LOG_CRIT, "Can't connect stdin to /dev/null ($!), exiting!"); 13475 exit(1); 13476 } 13477 13478 if (!open(STDOUT, '>/dev/null')) { 13479 log_msg(LOG_CRIT, "Can't connect stdout to /dev/null ($!), exiting!"); 13480 exit(1); 13481 } 13482 13483 if (!open(STDERR, '>&STDOUT')) { 13484 log_msg(LOG_CRIT, 13485 "Can't connect stderr to stdout with dup ($!), exiting!"); 13486 exit(1); 13487 } 13488 13489 log_msg(LOG_DEBUG, "Daemonization complete"); 13490 13491} 13492 13493 13494# Parameters: - 13495# Action: create the pid file for the process 13496 13497sub create_pidfile { 13498 13499 my($file) = $_[0]; 13500 my($fh); 13501 13502 if (open($fh, ">$file")) { 13503 print $fh "$$\n"; 13504 close($fh); 13505 } else { 13506 log_msg(LOG_CRIT, "Can't open pidfile $file for writing ($!), exiting!"); 13507 exit(1); 13508 } 13509 13510} 13511 13512 13513# Parameters: par1 - effective group ID 13514# par2, par3, .. - IDs of supplementary groups 13515# Action: set effective group ID to par1 and supplementary groups to 13516# par1, par2, par3, etc. Return 1 if supplementary groups were 13517# successfully set, 0 otherwise. 13518 13519sub set_supplementary_groups { 13520 13521 my($egid) = $_[0]; 13522 my(@supp_gids) = @_; 13523 my(%gids, %result, @list, $gid); 13524 13525 # since perl POSIX module lacks setgroups(), set the $) special variable 13526 # accordingly (the first element in the string must be effective group ID, 13527 # while the following elements define supplementary groups) 13528 13529 $) = "$egid " . join(" ", @supp_gids); 13530 13531 # to verify if setting supplementary groups succeeded, check $) variable 13532 # (note that $) can report the same supplementary group ID more than once) 13533 13534 @list = split(' ', $) ); 13535 13536 # if effective group ID is not properly set, setting the groups has failed 13537 13538 if ($egid != $list[0]) { return 0; } 13539 13540 # since POSIX leaves it open whether effective group ID is reported in 13541 # the list of supplementary groups, create %result from all gids in $) 13542 13543 %gids = map { $_ => 1 } @supp_gids; 13544 %result = map { $_ => 1 } @list; 13545 13546 # verify that all requested groups are among supplementary groups 13547 13548 foreach $gid (keys %gids) { 13549 if (!exists($result{$gid})) { return 0; } 13550 delete $result{$gid}; 13551 } 13552 13553 # verify that other groups are not among supplementary groups 13554 13555 if (scalar(%result)) { return 0; } 13556 13557 return 1; 13558 13559} 13560 13561 13562# Parameters: - 13563# Action: set the user and group ID, and exit if an error is encountered. 13564# This function logs its error messages to standard error, since 13565# the logfile has to be opened after a call to this function with 13566# a new user and group ID. 13567 13568sub set_user_and_group_id { 13569 13570 my($userid, $groupid, $groupname, $gname, $gid); 13571 my(@pwinfo, %supp_gids); 13572 13573 # --user and --group options are not supported on Windows 13574 13575 if ($WIN32) { 13576 print STDERR "'--user' and '--group' options are not supported on Win32\n"; 13577 exit(1); 13578 } 13579 13580 # --user and --group options can be used if process is running with euid 0 13581 13582 if ($>) { 13583 print STDERR "'--user' and '--group' options can only be used by root " . 13584 "(current euid is not 0 but $>)\n"; 13585 exit(1); 13586 } 13587 13588 # find numerical ID for the user name provided with --user option 13589 13590 @pwinfo = getpwnam($username); 13591 13592 if (!scalar(@pwinfo)) { 13593 print STDERR "User name '$username' does not exist, exiting!\n"; 13594 exit(1); 13595 } 13596 13597 $userid = $pwinfo[2]; 13598 13599 if (!$userid) { 13600 print STDERR 13601 "Can't drop root privileges by setting user to '$username', exiting!\n"; 13602 exit(1); 13603 } 13604 13605 # Find numerical IDs for group names provided with --group options. 13606 # If several --group options were provided, the first group defines the 13607 # group ID. If no --group option was provided, group ID is set to the user's 13608 # primary group. Also, each group is treated as a supplementary group. 13609 13610 %supp_gids = (); 13611 13612 if (scalar(@groupnames)) { 13613 13614 foreach $gname (@groupnames) { 13615 $gid = getgrnam($gname); 13616 if (!defined($gid)) { 13617 print STDERR "Group name '$gname' does not exist, exiting!\n"; 13618 exit(1); 13619 } 13620 if (!scalar(%supp_gids)) { 13621 $groupname = $gname; 13622 $groupid = $gid; 13623 } 13624 $supp_gids{$gid} = $gname; 13625 } 13626 13627 } else { 13628 13629 $groupid = $pwinfo[3]; 13630 $groupname = getgrgid($groupid); 13631 if (!defined($groupname)) { 13632 print STDERR "Group ID '$groupid' does not exist, exiting!\n"; 13633 exit(1); 13634 } 13635 $supp_gids{$groupid} = $groupname; 13636 13637 } 13638 13639 # Set the group ID with setgid(). This must be done before changing 13640 # the user ID, since otherwise there might not be enough privileges for 13641 # successful setgid() call. Although setgid() behavior depends on 13642 # the platform (e.g., behavior on BSD and Linux is different), it always 13643 # sets the effective, real, and saved set-group ID if effective user ID 13644 # is 0 (verified above). Also note that some ancient versions of perl do 13645 # not return 'undef' if setgid() fails but rather the value of the $) 13646 # special variable. Therefore, we also check if both effective and real 13647 # group ID are properly set after setgid() has been called (the IDs are 13648 # first elements in strings provided by $) and $( variables). 13649 13650 if (!POSIX::setgid($groupid) || (split(' ', $) ))[0] != $groupid 13651 || (split(' ', $( ))[0] != $groupid) { 13652 print STDERR "Can't set group to '$groupname' ($!), exiting!\n"; 13653 exit(1); 13654 } 13655 13656 # set supplementary groups (this must be done before changing the user ID, 13657 # since otherwise there might not be enough privileges for that) 13658 13659 if (!set_supplementary_groups($groupid, keys %supp_gids)) { 13660 print STDERR "Can't set supplementary groups to '" . 13661 join(" ", values %supp_gids) . "', exiting!\n"; 13662 exit(1); 13663 } 13664 13665 # Set the user ID with setuid(). Although setuid() behavior depends on 13666 # the platform (e.g., behavior on BSD and Linux is different), it always 13667 # sets the effective, real, and saved set-user ID if effective user ID 13668 # is 0 (verified above). Also note that some ancient versions of perl do 13669 # not return 'undef' if setuid() fails but rather the value of the $> 13670 # special variable. Therefore, we also check if both effective and real 13671 # user ID ($> and $<) are properly set after setuid() has been called. 13672 13673 if (!POSIX::setuid($userid) || $> != $userid || $< != $userid) { 13674 print STDERR "Can't set user to '$username' ($!), exiting!\n"; 13675 exit(1); 13676 } 13677 13678} 13679 13680 13681# Parameters: - 13682# Action: Set the file mode creation mask (if the current platform does 13683# not support umask(2) system call, umask() returns undef). 13684# This function logs its error messages to standard error, since 13685# the logfile has to be opened after a call to this function with 13686# a new umask. 13687 13688sub set_umask { 13689 13690 if (!defined(umask($umask))) { 13691 print STDERR "'--umask' option is not supported on this platform\n"; 13692 exit(1); 13693 } 13694 13695} 13696 13697 13698# Parameters: - 13699# Action: scan all rules loaded from configuration files, and set the 13700# --bufsize command line option to the largest number of lines 13701# configured with the ptype* field (e.g., if loaded rules have 13702# fields ptype=RegExp2, ptype2=PerlFunc5, ptype=RegExp3, and 13703# ptype=NSubStr4, assume --bufsize=5). 13704 13705sub set_bufsize_option { 13706 13707 my($conffile, $rule); 13708 my($type, $max, $i); 13709 13710 # the function will always set --bufsize to at least 1, even if 13711 # no valid rules have been defined in configuration files 13712 13713 $max = 1; 13714 13715 # scan all loaded rules for finding the value for --bufsize 13716 13717 foreach $conffile (@conffiles) { 13718 13719 foreach $rule (@{$configuration{$conffile}}) { 13720 13721 $type = $rule->{"Type"}; 13722 13723 if ($type == CALENDAR) { next; } 13724 13725 elsif ($type == SINGLE || $type == SINGLE_W_SUPPRESS || 13726 $type == SINGLE_W_SCRIPT || $type == SINGLE_W_THRESHOLD || 13727 $type == SINGLE_W_2_THRESHOLDS || $type == SUPPRESS || 13728 $type == JUMP) { 13729 13730 if ($max < $rule->{"PatLines"}) { $max = $rule->{"PatLines"}; } 13731 13732 } 13733 13734 elsif ($type == PAIR || $type == PAIR_W_WINDOW) { 13735 13736 if ($max < $rule->{"PatLines"}) { $max = $rule->{"PatLines"}; } 13737 if ($max < $rule->{"PatLines2"}) { $max = $rule->{"PatLines2"}; } 13738 13739 } 13740 13741 elsif ($type == EVENT_GROUP) { 13742 13743 foreach $i (@{$rule->{"PatLinesList"}}) { 13744 if ($max < $i) { $max = $i; } 13745 } 13746 13747 } 13748 } 13749 } 13750 13751 log_msg(LOG_DEBUG, "No --bufsize command line option or --bufsize=0,", 13752 "setting --bufsize to $max"); 13753 $bufsize = $max; 13754 13755 # in the case of --bufsize=1, always enable the --jointbuf option, 13756 # since there is no need to maintain multiple input buffers 13757 13758 if ($bufsize == 1) { $jointbuf = 1; } 13759 13760} 13761 13762 13763# Parameters: - 13764# Action: read and process options from command line and resource file 13765# (this function logs its error messages to standard error, since 13766# logging is not activated when the function is called) 13767 13768sub read_options { 13769 13770 my(@argv_backup, @values, $option, $fh); 13771 13772 # back up the @ARGV array 13773 13774 @argv_backup = @ARGV; 13775 13776 # open the file pointed by the SECRC environment variable and 13777 # read options from that file; empty lines and lines starting 13778 # with the #-symbol are ignored, rest of the lines are treated 13779 # as SEC command line options and pushed into @ARGV with 13780 # leading and trailing whitespace removed 13781 13782 if (exists($ENV{"SECRC"})) { 13783 13784 if (open($fh, $ENV{"SECRC"})) { 13785 13786 while (<$fh>) { 13787 if (/^\s*(.*\S)/) { 13788 $option = $1; 13789 if (index($option, '#') == 0) { next; } 13790 push @ARGV, $option; 13791 } 13792 } 13793 13794 close($fh); 13795 $rcfile_status = $ENV{"SECRC"}; 13796 13797 } else { 13798 print STDERR "Can't open resource file " . $ENV{"SECRC"} . " ($!)\n"; 13799 $rcfile_status = $ENV{"SECRC"} . " - open failed ($!)"; 13800 } 13801 13802 } else { $rcfile_status = "none"; } 13803 13804 # set the $sec_options global variable 13805 13806 $sec_options = join(" ", @ARGV); 13807 13808 # (re)set option variables to default values 13809 13810 @conffilepat = (); 13811 @inputfilepat = (); 13812 $input_timeout = 0; 13813 $timeout_script = undef; 13814 $reopen_timeout = 0; 13815 $check_timeout = 0; 13816 $poll_timeout = DEFAULT_POLLTIMEOUT; 13817 $socket_timeout = DEFAULT_SOCKETTIMEOUT; 13818 $blocksize = DEFAULT_BLOCKSIZE; 13819 $bufsize = 0; 13820 $evstoresize = 0; 13821 $cleantime = DEFAULT_CLEANTIME; 13822 $logfile = undef; 13823 $syslogf = undef; 13824 $debuglevel = 6; 13825 $pidfile = undef; 13826 $dumpfile = DEFAULT_DUMPFILE; 13827 $username = undef; 13828 @groupnames = (); 13829 $umask = undef; 13830 $ruleperf = 0; 13831 $dumpfts = 0; 13832 $dumpfjson = 0; 13833 $quoting = 0; 13834 $tail = 1; 13835 $fromstart = 0; 13836 $detach = 0; 13837 $jointbuf = 0; 13838 $keepopen = 1; 13839 $rwfifo = 1; 13840 $childterm = 1; 13841 $intevents = 0; 13842 $intcontexts = 0; 13843 $testonly = 0; 13844 $help = 0; 13845 $version = 0; 13846 13847 # parse the options given in command line and in SEC resource file 13848 # (GetOptions() prints parsing error messages to standard error) 13849 13850 GetOptions( "conf=s" => \@conffilepat, 13851 "input=s" => \@inputfilepat, 13852 "input-timeout|input_timeout=i" => \$input_timeout, 13853 "timeout-script|timeout_script=s" => \$timeout_script, 13854 "reopen-timeout|reopen_timeout=i" => \$reopen_timeout, 13855 "check-timeout|check_timeout=i" => \$check_timeout, 13856 "poll-timeout|poll_timeout=f" => \$poll_timeout, 13857 "socket-timeout|socket_timeout=i" => \$socket_timeout, 13858 "blocksize=i" => \$blocksize, 13859 "bufsize=i" => \$bufsize, 13860 "evstoresize=i" => \$evstoresize, 13861 "cleantime=i" => \$cleantime, 13862 "log=s" => \$logfile, 13863 "syslog=s" => \$syslogf, 13864 "debug=i", \$debuglevel, 13865 "pid=s" => \$pidfile, 13866 "dump=s" => \$dumpfile, 13867 "user=s" => \$username, 13868 "group=s" => \@groupnames, 13869 "umask=o" => \$umask, 13870 "ruleperf!" => \$ruleperf, 13871 "dumpfts!" => \$dumpfts, 13872 "dumpfjson!" => \$dumpfjson, 13873 "quoting!" => \$quoting, 13874 "tail!" => \$tail, 13875 "fromstart!" => \$fromstart, 13876 "detach!" => \$detach, 13877 "jointbuf!" => \$jointbuf, 13878 "keepopen!" => \$keepopen, 13879 "rwfifo!" => \$rwfifo, 13880 "childterm!" => \$childterm, 13881 "intevents!" => \$intevents, 13882 "intcontexts!" => \$intcontexts, 13883 "testonly!" => \$testonly, 13884 "help|?" => \$help, 13885 "version" => \$version, 13886 "<>" => sub { print STDERR "Unknown argument: $_[0]\n"; } ); 13887 13888 # check the values received from command line and resource file 13889 # and set option variables back to defaults, if necessary 13890 13891 @values = grep(length($_), @conffilepat); 13892 13893 if (scalar(@values) < scalar(@conffilepat)) { 13894 print STDERR "'--conf' option requires a non-empty value\n"; 13895 @conffilepat = @values; 13896 } 13897 13898 @values = grep(length($_), @inputfilepat); 13899 13900 if (scalar(@values) < scalar(@inputfilepat)) { 13901 print STDERR "'--input' option requires a non-empty value\n"; 13902 @inputfilepat = @values; 13903 } 13904 13905 if ($input_timeout < 0) { 13906 print STDERR "'--input-timeout' option requires a non-negative value\n"; 13907 $input_timeout = 0; 13908 } 13909 13910 if (defined($timeout_script) && !length($timeout_script)) { 13911 print STDERR "'--timeout-script' option requires a non-empty value\n"; 13912 $timeout_script = undef; 13913 } 13914 13915 if ($input_timeout > 0 && !defined($timeout_script)) { 13916 print STDERR 13917 "'--input-timeout' option requires the '--timeout-script' option\n"; 13918 $input_timeout = 0; 13919 } 13920 13921 if ($reopen_timeout < 0) { 13922 print STDERR "'--reopen-timeout' option requires a non-negative value\n"; 13923 $reopen_timeout = 0; 13924 } 13925 13926 if ($check_timeout < 0) { 13927 print STDERR "'--check-timeout' option requires a non-negative value\n"; 13928 $check_timeout = 0; 13929 } 13930 13931 if ($poll_timeout < 0) { 13932 print STDERR "'--poll-timeout' option requires a non-negative value\n"; 13933 $poll_timeout = DEFAULT_POLLTIMEOUT; 13934 } 13935 13936 if ($socket_timeout <= 0) { 13937 print STDERR "'--socket-timeout' option requires a positive value\n"; 13938 $socket_timeout = DEFAULT_SOCKETTIMEOUT; 13939 } 13940 13941 if ($blocksize <= 0) { 13942 print STDERR "'--blocksize' option requires a positive value\n"; 13943 $blocksize = DEFAULT_BLOCKSIZE; 13944 } 13945 13946 if ($bufsize < 0) { 13947 print STDERR "'--bufsize' option requires a non-negative value\n"; 13948 $bufsize = 0; 13949 } 13950 13951 if ($evstoresize < 0) { 13952 print STDERR "'--evstoresize' option requires a non-negative value\n"; 13953 $evstoresize = 0; 13954 } 13955 13956 if ($cleantime < 0) { 13957 print STDERR "'--cleantime' option requires a non-negative value\n"; 13958 $cleantime = DEFAULT_CLEANTIME; 13959 } 13960 13961 if (defined($logfile) && !length($logfile)) { 13962 print STDERR "'--log' option requires a non-empty value\n"; 13963 $logfile = undef; 13964 } 13965 13966 if (defined($syslogf) && !$SYSLOGAVAIL) { 13967 print STDERR "'--syslog' option requires Perl Sys::Syslog module\n"; 13968 $syslogf = undef; 13969 } 13970 13971 if (defined($syslogf) && !length($syslogf)) { 13972 print STDERR "'--syslog' option requires a non-empty value\n"; 13973 $syslogf = undef; 13974 } 13975 13976 if ($debuglevel < 1 || $debuglevel > 6) { 13977 print STDERR "'--debug' option requires a value from range 1..6\n"; 13978 $debuglevel = 6; 13979 } 13980 13981 if (defined($pidfile) && !length($pidfile)) { 13982 print STDERR "'--pid' option requires a non-empty value\n"; 13983 $pidfile = undef; 13984 } 13985 13986 if (!length($dumpfile)) { 13987 print STDERR "'--dump' option requires a non-empty value\n"; 13988 $dumpfile = DEFAULT_DUMPFILE; 13989 } 13990 13991 if (defined($username) && !length($username)) { 13992 print STDERR "'--user' option requires a non-empty value\n"; 13993 $username = undef; 13994 } 13995 13996 @values = grep(length($_), @groupnames); 13997 13998 if (scalar(@values) < scalar(@groupnames)) { 13999 print STDERR "'--group' option requires a non-empty value\n"; 14000 @groupnames = @values; 14001 } 14002 14003 if (scalar(@groupnames) && !defined($username)) { 14004 print STDERR "'--group' option requires the '--user' option\n"; 14005 @groupnames = (); 14006 } 14007 14008 if (defined($umask) && ($umask < 0 || $umask > 511)) { 14009 print STDERR "'--umask' option requires a value from range 0..0777\n"; 14010 $umask = undef; 14011 } 14012 14013 if ($dumpfjson && !$JSONAVAIL) { 14014 print STDERR "'--dumpfjson' option requires Perl JSON::PP module\n"; 14015 $dumpfjson = 0; 14016 } 14017 14018 # in the case of --bufsize=1, always enable the --jointbuf option, 14019 # since there is no need to maintain multiple input buffers 14020 14021 if ($bufsize == 1) { $jointbuf = 1; } 14022 14023 # restore the @ARGV array 14024 14025 @ARGV = @argv_backup; 14026 14027} 14028 14029 14030############################ 14031# Function for the main loop 14032############################ 14033 14034 14035# Parameters: - 14036# Action: the main loop - receive events from inputs and process them 14037 14038sub main_loop { 14039 14040 my($line, $evcont, $file); 14041 my($conffile, $childdata); 14042 14043 for (;;) { 14044 14045 # check the status of child processes, and poll them for new events if 14046 # the event buffer is empty (if a process has exited, all its remaining 14047 # events are read and appended to event buffer even if it is not empty) 14048 14049 if (scalar(%children)) { 14050 $childdata = check_children(); 14051 } else { 14052 $childdata = 0; 14053 } 14054 14055 # if there are pending events in the event buffer or the read buffer, 14056 # read new line from there, otherwise read new line from input stream. 14057 14058 if (scalar(@events)) { 14059 $line = shift @events; 14060 $evcont = shift @events; 14061 $file = undef; 14062 } elsif (scalar(@readbuffer)) { 14063 $line = shift @readbuffer; 14064 $file = shift @readbuffer; 14065 } else { 14066 read_line($line, $file); 14067 } 14068 14069 if (defined($line)) { 14070 14071 # with --intcontexts option, set up internal context and store its 14072 # name to $intcontextname global variable (this variable will be used 14073 # for setting the $+{_intcontext} match variable) 14074 14075 if ($intcontexts) { 14076 $intcontextname = defined($file)?$inputsrc{$file}->{"context"}:$evcont; 14077 $int_context->{"Aliases"}->{$intcontextname} = 1; 14078 $context_list{$intcontextname} = $int_context; 14079 } 14080 14081 # update input buffers (they are implemented as circular buffers, since 14082 # according to benchmarks an array queue using shift and push is slower) 14083 # note that joint buffer is also maintained during --nojointbuf mode, 14084 # since @input_sources list is used for pattern matching purposes 14085 14086 $bufpos = ($bufpos + 1) % $bufsize; 14087 $input_buffer[$bufpos] = $line; 14088 $input_sources[$bufpos] = $file; 14089 14090 if (!$jointbuf) { 14091 if (defined($file)) { 14092 $input_buffers{$file}->{"BufPos"} = ($input_buffers{$file}->{"BufPos"} + 1) % $bufsize; 14093 $input_buffers{$file}->{"Events"}->[$input_buffers{$file}->{"BufPos"}] = $line; 14094 } else { 14095 $event_buffer{"BufPos"} = ($event_buffer{"BufPos"} + 1) % $bufsize; 14096 $event_buffer{"Events"}->[$event_buffer{"BufPos"}] = $line; 14097 } 14098 } 14099 14100 # clear pattern match cache 14101 14102 %pmatch_cache = (); 14103 14104 # process rules from configuration files 14105 14106 foreach $conffile (@maincfiles) { 14107 if (process_rules($conffile)) { last; } 14108 } 14109 14110 # with --intcontexts option, drop previously created internal context 14111 14112 if ($intcontexts) { 14113 delete $context_list{$intcontextname}; 14114 delete $int_context->{"Aliases"}->{$intcontextname}; 14115 $intcontextname = undef; 14116 } 14117 14118 if (defined($file)) { ++$inputsrc{$file}->{"lines"}; } 14119 ++$processedlines; 14120 14121 } elsif (!$file) { 14122 14123 # if --notail mode is active and all input files have been closed, exit; 14124 # if no new data was appended to input files, sleep with select(), 14125 # unless some child process returned data during last polling round 14126 14127 if (!$tail && !grep($inputsrc{$_}->{"open"}, @inputfiles)) { 14128 14129 # after generating SEC_SHUTDOWN event, SEC will sleep for TERMTIMEOUT 14130 # seconds, so that child processes that were triggered by SEC_SHUTDOWN 14131 # have time to create a signal handler for SIGTERM if they wish 14132 14133 if ($intevents) { 14134 internal_event("SEC_SHUTDOWN"); 14135 if ($childterm) { sleep(TERMTIMEOUT); } 14136 } 14137 14138 if ($childterm) { child_cleanup(); } 14139 exit(0); 14140 14141 } 14142 14143 # sleep if no new data were read from input files or child processes 14144 14145 if (!$childdata) { select(undef, undef, undef, $poll_timeout); } 14146 14147 } 14148 14149 # search lists for accomplishing timed tasks and removing obsolete elements 14150 14151 if (time() - $lastcleanuptime >= $cleantime) { 14152 process_lists(); 14153 $lastcleanuptime = time(); 14154 } 14155 14156 # check signal flags 14157 14158 if ($sigreceived) { 14159 check_signals(); 14160 $sigreceived = 0; 14161 } 14162 14163 } 14164} 14165 14166 14167################################################################## 14168# ------------------------- MAIN PROGRAM ------------------------- 14169################################################################## 14170 14171### Set function pointers and create a template for internal contexts 14172 14173$matchfunc[SUBSTR] = \&match_substr; 14174$matchfunc[REGEXP] = \&match_regexp; 14175$matchfunc[PERLFUNC] = \&match_perlfunc; 14176$matchfunc[CACHED] = \&match_cached; 14177$matchfunc[NSUBSTR] = \&match_nsubstr; 14178$matchfunc[NREGEXP] = \&match_nregexp; 14179$matchfunc[NPERLFUNC] = \&match_nperlfunc; 14180$matchfunc[NCACHED] = \&match_ncached; 14181$matchfunc[TVALUE] = \&match_tvalue; 14182 14183$matchrulefunc[SINGLE] = \&match_1pattern_rule; 14184$matchrulefunc[SINGLE_W_SCRIPT] = \&match_1pattern_rule; 14185$matchrulefunc[SINGLE_W_SUPPRESS] = \&match_1pattern_rule; 14186$matchrulefunc[PAIR] = \&match_2pattern_rule; 14187$matchrulefunc[PAIR_W_WINDOW] = \&match_2pattern_rule; 14188$matchrulefunc[SINGLE_W_THRESHOLD] = \&match_1pattern_rule; 14189$matchrulefunc[SINGLE_W_2_THRESHOLDS] = \&match_1pattern_rule; 14190$matchrulefunc[EVENT_GROUP] = \&match_eventgroup_rule; 14191$matchrulefunc[SUPPRESS] = \&match_1pattern_rule; 14192$matchrulefunc[JUMP] = \&match_1pattern_rule; 14193 14194$matchegrpfunc[SUBSTR] = \&match_eventgroup_substr; 14195$matchegrpfunc[REGEXP] = \&match_eventgroup_regexp; 14196$matchegrpfunc[PERLFUNC] = \&match_eventgroup_perlfunc; 14197$matchegrpfunc[NSUBSTR] = \&match_eventgroup_nsubstr; 14198$matchegrpfunc[NREGEXP] = \&match_eventgroup_nregexp; 14199$matchegrpfunc[NPERLFUNC] = \&match_eventgroup_nperlfunc; 14200 14201$processrulefunc[SINGLE] = \&process_single_rule; 14202$processrulefunc[SINGLE_W_SCRIPT] = \&process_singlewithscript_rule; 14203$processrulefunc[SINGLE_W_SUPPRESS] = \&process_singlewithsuppress_rule; 14204$processrulefunc[PAIR] = \&process_pair_rule; 14205$processrulefunc[PAIR_W_WINDOW] = \&process_pairwithwindow_rule; 14206$processrulefunc[SINGLE_W_THRESHOLD] = \&process_singlewiththreshold_rule; 14207$processrulefunc[SINGLE_W_2_THRESHOLDS] = \&process_singlewith2thresholds_rule; 14208$processrulefunc[EVENT_GROUP] = \&process_eventgroup_rule; 14209$processrulefunc[JUMP] = \&process_jump_rule; 14210 14211$actioncopyfunc[NONE] = \©_one_elem_action; 14212$actioncopyfunc[LOGONLY] = \©_two_elem_action; 14213$actioncopyfunc[WRITE] = \©_three_elem_action; 14214$actioncopyfunc[WRITEN] = \©_three_elem_action; 14215$actioncopyfunc[CLOSEF] = \©_two_elem_action; 14216$actioncopyfunc[OWRITECL] = \©_three_elem_action; 14217$actioncopyfunc[UDGRAM] = \©_three_elem_action; 14218$actioncopyfunc[CLOSEUDGR] = \©_two_elem_action; 14219$actioncopyfunc[USTREAM] = \©_three_elem_action; 14220$actioncopyfunc[CLOSEUSTR] = \©_two_elem_action; 14221$actioncopyfunc[UDPSOCK] = \©_three_elem_action; 14222$actioncopyfunc[CLOSEUDP] = \©_two_elem_action; 14223$actioncopyfunc[TCPSOCK] = \©_three_elem_action; 14224$actioncopyfunc[CLOSETCP] = \©_two_elem_action; 14225$actioncopyfunc[SHELLCOMMAND] = \©_two_elem_action; 14226$actioncopyfunc[COMMANDEXEC] = \©_cmdexec_spawnexec_action; 14227$actioncopyfunc[SPAWN] = \©_two_elem_action; 14228$actioncopyfunc[SPAWNEXEC] = \©_cmdexec_spawnexec_action; 14229$actioncopyfunc[CSPAWN] = \©_three_elem_action; 14230$actioncopyfunc[CSPAWNEXEC] = \©_cspawnexec_pipeexec_reportexec_action; 14231$actioncopyfunc[PIPE] = \©_three_elem_action; 14232$actioncopyfunc[PIPEEXEC] = \©_cspawnexec_pipeexec_reportexec_action; 14233$actioncopyfunc[CREATECONTEXT] = \©_create_set_action; 14234$actioncopyfunc[DELETECONTEXT] = \©_two_elem_action; 14235$actioncopyfunc[OBSOLETECONTEXT] = \©_two_elem_action; 14236$actioncopyfunc[SETCONTEXT] = \©_create_set_action; 14237$actioncopyfunc[ALIAS] = \©_three_elem_action; 14238$actioncopyfunc[UNALIAS] = \©_two_elem_action; 14239$actioncopyfunc[ADD] = \©_three_elem_action; 14240$actioncopyfunc[PREPEND] = \©_three_elem_action; 14241$actioncopyfunc[FILL] = \©_three_elem_action; 14242$actioncopyfunc[REPORT] = \©_three_elem_action; 14243$actioncopyfunc[REPORTEXEC] = \©_cspawnexec_pipeexec_reportexec_action; 14244$actioncopyfunc[COPYCONTEXT] = \©_three_elem_action; 14245$actioncopyfunc[EMPTYCONTEXT] = \©_three_elem_action; 14246$actioncopyfunc[POP] = \©_three_elem_action; 14247$actioncopyfunc[SHIFT] = \©_three_elem_action; 14248$actioncopyfunc[EXISTS] = \©_three_elem_action; 14249$actioncopyfunc[GETSIZE] = \©_three_elem_action; 14250$actioncopyfunc[GETALIASES] = \©_three_elem_action; 14251$actioncopyfunc[GETLIFETIME] = \©_three_elem_action; 14252$actioncopyfunc[SETLIFETIME] = \©_three_elem_action; 14253$actioncopyfunc[GETCTIME] = \©_three_elem_action; 14254$actioncopyfunc[SETCTIME] = \©_three_elem_action; 14255$actioncopyfunc[EVENT] = \©_three_elem_action; 14256$actioncopyfunc[TEVENT] = \©_three_elem_action; 14257$actioncopyfunc[CEVENT] = \©_four_elem_action; 14258$actioncopyfunc[RESET] = \©_four_elem_action; 14259$actioncopyfunc[GETWINPOS] = \©_five_elem_action; 14260$actioncopyfunc[SETWINPOS] = \©_five_elem_action; 14261$actioncopyfunc[ASSIGN] = \©_three_elem_action; 14262$actioncopyfunc[ASSIGNSQ] = \©_three_elem_action; 14263$actioncopyfunc[FREE] = \©_two_elem_action; 14264$actioncopyfunc[EVAL] = \©_three_elem_action; 14265$actioncopyfunc[CALL] = \©_call_action; 14266$actioncopyfunc[LCALL] = \©_lcall_action; 14267$actioncopyfunc[REWRITE] = \©_three_elem_action; 14268$actioncopyfunc[ADDINPUT] = \©_four_elem_action; 14269$actioncopyfunc[DROPINPUT] = \©_two_elem_action; 14270$actioncopyfunc[SIGEMUL] = \©_two_elem_action; 14271$actioncopyfunc[VARIABLESET] = \©_three_elem_action; 14272$actioncopyfunc[IF] = \©_if_action; 14273$actioncopyfunc[WHILE] = \©_while_action; 14274$actioncopyfunc[BREAK] = \©_one_elem_action; 14275$actioncopyfunc[CONTINUE] = \©_one_elem_action; 14276 14277$actionsubstfunc[NONE] = \&subst_none_break_continue; 14278$actionsubstfunc[LOGONLY] = \&subst_two_elem_action; 14279$actionsubstfunc[WRITE] = \&subst_three_elem_action; 14280$actionsubstfunc[WRITEN] = \&subst_three_elem_action; 14281$actionsubstfunc[CLOSEF] = \&subst_two_elem_action; 14282$actionsubstfunc[OWRITECL] = \&subst_three_elem_action; 14283$actionsubstfunc[UDGRAM] = \&subst_three_elem_action; 14284$actionsubstfunc[CLOSEUDGR] = \&subst_two_elem_action; 14285$actionsubstfunc[USTREAM] = \&subst_three_elem_action; 14286$actionsubstfunc[CLOSEUSTR] = \&subst_two_elem_action; 14287$actionsubstfunc[UDPSOCK] = \&subst_three_elem_action; 14288$actionsubstfunc[CLOSEUDP] = \&subst_two_elem_action; 14289$actionsubstfunc[TCPSOCK] = \&subst_three_elem_action; 14290$actionsubstfunc[CLOSETCP] = \&subst_two_elem_action; 14291$actionsubstfunc[SHELLCOMMAND] = \&subst_two_elem_action; 14292$actionsubstfunc[COMMANDEXEC] = \&subst_cmdexec_spawnexec_action; 14293$actionsubstfunc[SPAWN] = \&subst_two_elem_action; 14294$actionsubstfunc[SPAWNEXEC] = \&subst_cmdexec_spawnexec_action; 14295$actionsubstfunc[CSPAWN] = \&subst_three_elem_action; 14296$actionsubstfunc[CSPAWNEXEC] = \&subst_cspawnexec_pipeexec_reportexec_action; 14297$actionsubstfunc[PIPE] = \&subst_three_elem_action; 14298$actionsubstfunc[PIPEEXEC] = \&subst_cspawnexec_pipeexec_reportexec_action; 14299$actionsubstfunc[CREATECONTEXT] = \&subst_create_set_action; 14300$actionsubstfunc[DELETECONTEXT] = \&subst_two_elem_action; 14301$actionsubstfunc[OBSOLETECONTEXT] = \&subst_two_elem_action; 14302$actionsubstfunc[SETCONTEXT] = \&subst_create_set_action; 14303$actionsubstfunc[ALIAS] = \&subst_three_elem_action; 14304$actionsubstfunc[UNALIAS] = \&subst_two_elem_action; 14305$actionsubstfunc[ADD] = \&subst_three_elem_action; 14306$actionsubstfunc[PREPEND] = \&subst_three_elem_action; 14307$actionsubstfunc[FILL] = \&subst_three_elem_action; 14308$actionsubstfunc[REPORT] = \&subst_three_elem_action; 14309$actionsubstfunc[REPORTEXEC] = \&subst_cspawnexec_pipeexec_reportexec_action; 14310$actionsubstfunc[COPYCONTEXT] = \&subst_copy_empty_etc_action; 14311$actionsubstfunc[EMPTYCONTEXT] = \&subst_copy_empty_etc_action; 14312$actionsubstfunc[POP] = \&subst_copy_empty_etc_action; 14313$actionsubstfunc[SHIFT] = \&subst_copy_empty_etc_action; 14314$actionsubstfunc[EXISTS] = \&subst_event_assign_etc_action; 14315$actionsubstfunc[GETSIZE] = \&subst_event_assign_etc_action; 14316$actionsubstfunc[GETALIASES] = \&subst_event_assign_etc_action; 14317$actionsubstfunc[GETLIFETIME] = \&subst_event_assign_etc_action; 14318$actionsubstfunc[SETLIFETIME] = \&subst_three_elem_action; 14319$actionsubstfunc[GETCTIME] = \&subst_event_assign_etc_action; 14320$actionsubstfunc[SETCTIME] = \&subst_three_elem_action; 14321$actionsubstfunc[EVENT] = \&subst_event_assign_etc_action; 14322$actionsubstfunc[TEVENT] = \&subst_three_elem_action; 14323$actionsubstfunc[CEVENT] = \&subst_four_elem_action; 14324$actionsubstfunc[RESET] = \&subst_reset_action; 14325$actionsubstfunc[GETWINPOS] = \&subst_getwpos_action; 14326$actionsubstfunc[SETWINPOS] = \&subst_setwpos_action; 14327$actionsubstfunc[ASSIGN] = \&subst_event_assign_etc_action; 14328$actionsubstfunc[ASSIGNSQ] = \&subst_event_assign_etc_action; 14329$actionsubstfunc[FREE] = \&subst_free; 14330$actionsubstfunc[EVAL] = \&subst_event_assign_etc_action; 14331$actionsubstfunc[CALL] = \&subst_call_action; 14332$actionsubstfunc[LCALL] = \&subst_lcall_action; 14333$actionsubstfunc[REWRITE] = \&subst_three_elem_action; 14334$actionsubstfunc[ADDINPUT] = \&subst_four_elem_action; 14335$actionsubstfunc[DROPINPUT] = \&subst_two_elem_action; 14336$actionsubstfunc[SIGEMUL] = \&subst_two_elem_action; 14337$actionsubstfunc[VARIABLESET] = \&subst_event_assign_etc_action; 14338$actionsubstfunc[IF] = \&subst_if_action; 14339$actionsubstfunc[WHILE] = \&subst_while_action; 14340$actionsubstfunc[BREAK] = \&subst_none_break_continue; 14341$actionsubstfunc[CONTINUE] = \&subst_none_break_continue; 14342 14343$execactionfunc[NONE] = \&execute_none_action; 14344$execactionfunc[LOGONLY] = \&execute_logonly_action; 14345$execactionfunc[WRITE] = \&execute_write_action; 14346$execactionfunc[WRITEN] = \&execute_write_action; 14347$execactionfunc[CLOSEF] = \&execute_closef_action; 14348$execactionfunc[OWRITECL] = \&execute_owritecl_action; 14349$execactionfunc[UDGRAM] = \&execute_udgram_action; 14350$execactionfunc[CLOSEUDGR] = \&execute_closeudgr_action; 14351$execactionfunc[USTREAM] = \&execute_ustream_action; 14352$execactionfunc[CLOSEUSTR] = \&execute_closeustr_action; 14353$execactionfunc[UDPSOCK] = \&execute_udpsock_action; 14354$execactionfunc[CLOSEUDP] = \&execute_closeudp_action; 14355$execactionfunc[TCPSOCK] = \&execute_tcpsock_action; 14356$execactionfunc[CLOSETCP] = \&execute_closetcp_action; 14357$execactionfunc[SHELLCOMMAND] = \&execute_shellcmd_action; 14358$execactionfunc[COMMANDEXEC] = \&execute_cmdexec_action; 14359$execactionfunc[SPAWN] = \&execute_spawn_action; 14360$execactionfunc[SPAWNEXEC] = \&execute_spawnexec_action; 14361$execactionfunc[CSPAWN] = \&execute_cspawn_action; 14362$execactionfunc[CSPAWNEXEC] = \&execute_cspawnexec_action; 14363$execactionfunc[PIPE] = \&execute_pipe_action; 14364$execactionfunc[PIPEEXEC] = \&execute_pipeexec_action; 14365$execactionfunc[CREATECONTEXT] = \&execute_create_action; 14366$execactionfunc[DELETECONTEXT] = \&execute_delete_action; 14367$execactionfunc[OBSOLETECONTEXT] = \&execute_obsolete_action; 14368$execactionfunc[SETCONTEXT] = \&execute_set_action; 14369$execactionfunc[ALIAS] = \&execute_alias_action; 14370$execactionfunc[UNALIAS] = \&execute_unalias_action; 14371$execactionfunc[ADD] = \&execute_add_action; 14372$execactionfunc[PREPEND] = \&execute_prepend_action; 14373$execactionfunc[FILL] = \&execute_fill_action; 14374$execactionfunc[REPORT] = \&execute_report_action; 14375$execactionfunc[REPORTEXEC] = \&execute_reportexec_action; 14376$execactionfunc[COPYCONTEXT] = \&execute_copy_action; 14377$execactionfunc[EMPTYCONTEXT] = \&execute_empty_action; 14378$execactionfunc[POP] = \&execute_pop_action; 14379$execactionfunc[SHIFT] = \&execute_shift_action; 14380$execactionfunc[EXISTS] = \&execute_exists_action; 14381$execactionfunc[GETSIZE] = \&execute_getsize_action; 14382$execactionfunc[GETALIASES] = \&execute_getaliases_action; 14383$execactionfunc[GETLIFETIME] = \&execute_getltime_action; 14384$execactionfunc[SETLIFETIME] = \&execute_setltime_action; 14385$execactionfunc[GETCTIME] = \&execute_getctime_action; 14386$execactionfunc[SETCTIME] = \&execute_setctime_action; 14387$execactionfunc[EVENT] = \&execute_event_action; 14388$execactionfunc[TEVENT] = \&execute_tevent_action; 14389$execactionfunc[CEVENT] = \&execute_cevent_action; 14390$execactionfunc[RESET] = \&execute_reset_action; 14391$execactionfunc[GETWINPOS] = \&execute_getwpos_action; 14392$execactionfunc[SETWINPOS] = \&execute_setwpos_action; 14393$execactionfunc[ASSIGN] = \&execute_assign_action; 14394$execactionfunc[ASSIGNSQ] = \&execute_assignsq_action; 14395$execactionfunc[FREE] = \&execute_free_action; 14396$execactionfunc[EVAL] = \&execute_eval_action; 14397$execactionfunc[CALL] = \&execute_call_action; 14398$execactionfunc[LCALL] = \&execute_lcall_action; 14399$execactionfunc[REWRITE] = \&execute_rewrite_action; 14400$execactionfunc[ADDINPUT] = \&execute_addinput_action; 14401$execactionfunc[DROPINPUT] = \&execute_dropinput_action; 14402$execactionfunc[SIGEMUL] = \&execute_sigemul_action; 14403$execactionfunc[VARIABLESET] = \&execute_varset_action; 14404$execactionfunc[IF] = \&execute_if_action; 14405$execactionfunc[WHILE] = \&execute_while_action; 14406$execactionfunc[BREAK] = \&execute_break_action; 14407$execactionfunc[CONTINUE] = \&execute_continue_action; 14408 14409### create a template that is shared by all internal contexts; note that 14410### the Internal flag blocks actions that modify the internal context 14411 14412$int_context = { "Time" => time(), 14413 "Window" => 0, 14414 "Buffer" => [], 14415 "Action" => [], 14416 "Desc" => "SEC internal", 14417 "Internal" => 1, 14418 "Aliases" => { } }; 14419 14420### ignore SIGPIPE (done before generating any output) 14421 14422$SIG{PIPE} = 'IGNORE'; 14423 14424### Read and process SEC options from command line and resource file 14425 14426read_options(); 14427 14428### If requested, print usage/version info and exit 14429 14430if ($help) { 14431 print $SEC_USAGE; 14432 exit(0); 14433} 14434 14435if ($version) { 14436 print $SEC_VERSION, "\n"; 14437 print $SEC_COPYRIGHT, "\n"; 14438 print $SEC_LICENSE; 14439 exit(0); 14440} 14441 14442### If requested, change the user and group ID 14443 14444if (defined($username)) { set_user_and_group_id(); } 14445 14446### If requested, change the umask 14447 14448if (defined($umask)) { set_umask(); } 14449 14450### Start the logging 14451 14452if (defined($logfile)) { open_logfile($logfile); } else { $logopen = 0; } 14453if (defined($syslogf)) { open_syslog($syslogf); } else { $syslogopen = 0; } 14454 14455log_msg(LOG_NOTICE, "$SEC_VERSION"); 14456 14457### If --detach flag was specified, chdir to / for not disturbing future 14458### unmount of current filesystem. Must be done before read_config() to 14459### receive error messages about scripts that would not be found at runtime 14460 14461if ($detach) { 14462 log_msg(LOG_NOTICE, "Changing working directory to /"); 14463 chdir('/'); 14464} 14465 14466### Read in configuration 14467 14468my $config_ok = read_config(); 14469 14470if ($testonly) { 14471 if ($config_ok) { exit(0); } else { exit(1); } 14472} 14473 14474### if --bufsize command line option has not been provided or --bufsize=0, 14475### set --bufsize by analyzing loaded rules 14476 14477if (!$bufsize) { set_bufsize_option(); } 14478 14479### Open input sources 14480 14481if ($fromstart) { open_input(0); } 14482elsif ($tail) { open_input(-1); } 14483else { open_input(0); } 14484 14485### Daemonize the process, if --detach flag was specified 14486 14487if ($detach) { daemonize(); } 14488 14489### Create pidfile - must be done after daemonization 14490 14491if (defined($pidfile)) { create_pidfile($pidfile); } 14492 14493### Set signal handlers 14494 14495$sigreceived = 0; 14496 14497$refresh = 0; 14498$SIG{HUP} = \&hup_handler; 14499 14500$softrefresh = 0; 14501$SIG{ABRT} = \&abrt_handler; 14502 14503$dumpdata = 0; 14504$SIG{USR1} = \&usr1_handler; 14505 14506$openlog = 0; 14507$SIG{USR2} = \&usr2_handler; 14508 14509$debuglevelinc = 0; 14510 14511if (override_sigint()) { 14512 $SIG{INT} = \&int_handler; 14513} else { 14514 log_msg(LOG_NOTICE, 14515 "Interactive process, SIGINT can't be used for changing the logging level"); 14516} 14517 14518%terminate = (); 14519$SIG{TERM} = \&term_handler; 14520 14521### Set various global variables 14522 14523$startuptime = time(); 14524$processedlines = 0; 14525 14526### Initialize input buffers 14527 14528arrange_input_buffers(); 14529 14530### Initialize correlation list, context list, 14531### buffer list, and child process list 14532 14533%corr_list = (); 14534%context_list = (); 14535%children = (); 14536 14537### Initialize event buffers 14538 14539@events = (); 14540@pending_events = (); 14541 14542### Initialize builtin action list variables 14543 14544$timevar_update = time(); 14545set_actionlist_time_var($timevar_update); 14546set_actionlist_char_var(); 14547 14548### If --intevents flag was specified, create generate the SEC_STARTUP event 14549 14550if ($intevents) { internal_event("SEC_STARTUP"); } 14551 14552### search lists for accomplishing timed tasks and removing obsolete elements 14553### (triggers Calendar rules, must be done between SEC_STARTUP and main loop) 14554 14555process_lists(); 14556$lastcleanuptime = time(); 14557 14558### read lines from input stream and process them 14559 14560main_loop(); 14561