#!@PERL@ -w # vi: ts=4 autoindent # log_analysis, by Mordechai T. Abzug # RCD $Id: log_analysis.in,v 1.288 2006/09/29 08:14:02 morty Exp $ # definitely requires at least perl 5.005. Written under perl 5.8.8. require 5.005; # specify load location for modules that come with the distro my $pkgdatadir; BEGIN { $pkgdatadir="@prefix@/share/@PACKAGE@"; unshift @INC, $pkgdatadir } sub debug(@); sub empty($); use strict; use POSIX; use English qw(-no_match_vars); use Getopt::Std; use re 'eval'; use File::stat; use File::Basename; use FileHandle; use Sys::Syslog qw(:DEFAULT setlogsock); use User::grent; use User::pwent; my $prog=basename $0; my $cwd=getcwd; my $authorsfile='@prefix@/share/@PACKAGE@/AUTHORS'; my $URL='http://lug.umbc.edu/~mabzug1/log_analysis.html'; my @required_import_scalars=qw( other_host_message date_format output_message_one_day output_message_all_days output_message_all_days_in_range real_mode_output_format ); my @optional_import_scalars=qw( host_pat zone_pat ip_pat user_pat mail_user_pat file_pat word_pat mail_address mail_command memory_size_command PATH nodename osname osrelease rcs_command show_all real_mode days_ago output_file output_file_and_stdout suppress_commands suppress_footer real_mode_sleep_interval real_mode_check_interval real_mode_backlogs real_mode_no_actions_unless_is_daemon keep_all_raw_logs daemon_mode daemon_mode_pid_file daemon_mode_foreground report_mode_output_node_per_category report_mode_combine_nodes report_mode_combine_shows_nodes report_mode_combine_is_partway gui_mode gui_mode_modifier default_sort default_filter default_login_action default_action_format print_format save_format default_throttle_format gui_mode_config_file gui_mode_config_autosave gui_mode_config_savelocal gui_mode_config_save_does_rcs gui_mode_configure_disabled print_command gui_mode_print_all gui_mode_save_all gui_mode_save_events_file window_command process_all_nodenames umask priority domain leave_FQDNs_alone type_force ); my %import_scalars; @import_scalars{@optional_import_scalars, @required_import_scalars}=undef; my @required_import_arrays=qw( log_type_list ); my @optional_import_arrays=qw( optional_log_files commands_to_run ignore_categories priority_categories allow_nodenames filename_ignore_patterns gui_mode_configure_deny_users gui_mode_configure_deny_groups gui_mode_configure_allow_users gui_mode_configure_allow_groups ); my @arrays_to_become_hashes=qw( decompression_rules pgp_rules colors login_action pat ); my %import_arrays; @import_arrays{@required_import_arrays, @optional_import_arrays, @arrays_to_become_hashes}=undef; my %arrays_to_become_hashes; @arrays_to_become_hashes{@arrays_to_become_hashes}=undef; my @per_log_required_scalar_exts=qw( date_pattern date_format ); my @per_log_optional_scalar_exts=qw( nodename_pattern open_command open_command_is_continuous pipe_decompress_to_open ); my @per_log_required_array_exts=qw( filenames ); my @per_log_optional_array_exts=qw( pre_date_hook pre_skip_list_hook skip_list raw_rules ); my %dests_minimum=( CATEGORY=>[qw(dest_category format)], SKIP=>[qw()], LAST=>[qw()], UNIQUE=>[qw(dest_category format)], ); my %dests_deactivate=( CATEGORY=>[qw()], SKIP=>[qw(count format use_sprintf delete_if_unique dest_category)], LAST=>[qw(format use_sprintf delete_if_unique dest_category)], UNIQUE=>[qw(count)], ); my %var2type; $var2type{$_}="boolean" foreach (qw(show_all output_file_and_stdout keep_all_raw_logs process_all_nodenames leave_FQDNs_alone report_mode_output_node_per_category report_mode_combine_nodes report_mode_combine_shows_nodes real_mode_backlogs real_mode_no_actions_unless_is_daemon gui_mode_config_autosave gui_mode_config_savelocal gui_mode_config_save_does_rcs gui_mode_print_all gui_mode_save_all )); $var2type{$_}="int" foreach (qw(days_ago priority umask)); my %var2name=( gui_mode_config_autosave=>"autosave config", gui_mode_config_savelocal=>"save config if locally modified", ); # the next bunch of things are defined in the config, and can be overridden # in a user-defined config my (@required_log_files, @optional_log_files); my (%decompression_rules, %pgp_rules, %colors, @filename_ignore_patterns); my ( @gui_mode_configure_deny_users, @gui_mode_configure_deny_groups, @gui_mode_configure_allow_users, @gui_mode_configure_allow_groups, ); my (%login_action); my (%pat, $host_pat, $zone_pat, $ip_pat, $user_pat, $mail_user_pat); my ($file_pat, $word_pat); my ($date_format, $other_host_message); my ($output_message_one_day, $output_message_all_days); my ($output_message_all_days_in_range); my ($real_mode_output_format); my (@ignore_categories, @priority_categories, @unknown_categories); my $debug=0; # regular variables my (%count, %command_output); # the variables storing data for output my (%unknowns, %unknowns_raw); my %nodename_allowed; my $data_start=tell DATA; # save the position of the DATA start my $time_start=time; my @F; my $config_is_dirty; my $config_scalar={}; my $config_array={}; my (%patterns, %dests, %categories, %actions, @event_config); my ($event_change, %event_tree); my $minimum_version="0.21"; # the first version that this version can understand my $current_version="@VERSION@"; my $version_string="$prog $current_version"; my $include_depth_limit=16; # recusion limit for includes my %tags=( '%' => '%' ); my %backslash_tags=( "\\" => "\\", n => "\n", t => "\t"); my ($domain, $leave_FQDNs_alone); my $PATH='/usr/local/bin:/bin:/usr/bin:/usr/ucb'; my $umask="077"; my @legacy_pats=qw(host zone ip user mail_user file word); my %in_config; # checks if variables are defined in the config # gui mode: assorted packing arrays. # t/l=top/left, e/n=expand/noexpand, i=indent/flush my @Ptnf = qw(-side top -anchor nw); my @Ptef = qw(-side top -anchor nw -expand 1 -fill both); my @Ptxf = qw(-side top -anchor nw -expand 1 -fill x); my @Ptyf = qw(-side top -anchor nw -expand 1 -fill y); my @Ptni = (@Ptnf, -ipadx=>"0.5c"); my @Ptei = (@Ptef, -ipadx=>"0.5c"); my @Plnf = (@Ptnf, -side=>"left"); my @Plxf = (@Ptxf, -side=>"left"); my @Plyf = (@Ptxf, -side=>"left"); my @Plef = (@Ptef, -side=>"left"); my @Plni = (@Ptni, -side=>"left"); my @Prnf = (@Ptnf, -side=>"right"); # gui mode: standard args for frames my @frameargs=qw(-relief raised -borderwidth 2); my @simpleframe=qw(); my %tag2name=(c=>"category", h=>"host", d=>"data"); my %name2tag=(category=>"c", host=>"h", data=>"d"); $ENV{PATH}=$PATH; my %priority_val=( EMERG => 0, ALERT => 1, CRIT => 2, ERR => 3, WARNING => 4, NOTICE => 5, INFO => 6, DEBUG => 7, IGNORE => 10, ); my %priority_name=( EMERG => "Emergency", ALERT => "Alert", CRIT => "Critical", ERR => "Error", WARNING => "Warning", NOTICE => "Notice", INFO => "Informational", DEBUG => "Debug", IGNORE => "Ignore", ); my @priorities=qw(EMERG ALERT CRIT ERR WARNING NOTICE INFO DEBUG IGNORE); my $appname="$version_string @ ".(uname())[0]; my %opt; my $days_ago=1; my $internal_info=""; my $suppress_commands=0; my $suppress_footer=0; my $show_all=0; my $unknowns_only=0; my $unknowns_dir=0; my $mail_command; my $mail_address=""; my $pgp_type=""; my $type_force; my $priority=0; my $rcs_command; my $real_mode=0; my $real_mode_sleep_interval=1; my $real_mode_check_interval=300; my $real_mode_backlogs=0; my $real_mode_no_actions_unless_is_daemon; my $keep_all_raw_logs=0; my $remote_file; my $gui_mode=0; my $gui_mode_modifier="Alt"; my $gui_mode_configure_disabled; my $daemon_mode=0; my $daemon_mode_pid_file="/var/run/$prog.pid"; my $daemon_mode_foreground; my $report_mode_output_node_per_category; my $report_mode_combine_nodes; my $report_mode_combine_shows_nodes; my $report_mode_combine_is_partway; my $default_sort="funky"; my $default_filter; my $default_login_action; my $default_action_format; my $print_format; my $gui_mode_config_autosave; my $gui_mode_config_savelocal=1; my $gui_mode_config_save_does_rcs=1; my $gui_mode_config_file="$ENV{HOME}/.$prog.conf"; my $save_format; my $default_throttle_format; my $print_command; my $gui_mode_print_all; my $gui_mode_save_all; my $gui_mode_save_events_file; my $window_command; my $memory_size_command; my @commands_to_run; my $output_file; my $output_file_and_stdout; my $process_all_nodenames; my @allow_nodenames; my $nodename; my $osname; my $osrelease; # information we track specially in case someone uses -I my @categories; my @config_versions; # preprocessor variable namespace my %VAR; # widgets for gui_mode my $gui_mode_main; my $gui_mode_hlist; # some state variables for real mode my %real_file_state; my $real_mode_bypass; # this variable lets us not output in real mode when we # initially scan through the files my $real_mode_before_now; my $real_mode_last_check_time; my %real_mode_keep_open; my %throttle_state; # state for gui_mode my %gui_mode_state; my %gui_mode_hashref; my %gui_mode_find_what; my $gui_mode_status=""; # string to display at bottom of main window my $gui_mode_total=0; my $gui_mode_unknowns=0; my $gui_mode_selected=0; my $gui_mode_hidden=0; my $gui_mode_paused=0; my $gui_mode_status_updated=0; my $gui_mode_types_redone=0; my $gui_mode_busy=0; # are we currently in a busy state? my (%color2style, %color2bell); my @gui_mode_headers=qw/clear count host category data/; my %gui_mode_field_width=( clear => 5, count => 8, node => 15, host => 15, category => 45, data => 100, priority => 10, delete => 8, config => 10, summary => 10, logtype => 10, pattern => 50, local => 6, ); my $selected_pat; # assorted state variables my %last; # last message processed for file; needed for "last message repeated" my %multiplier; # multiplier associated with last message for "last message # repeated" my %incomplete; # if we catch a process in the middle of writing to a file, # before it writes the newline, we cache the incomplete line here my %unique; # used for tracking the special "unique" categories my %type_of; # track the type of a given file my (@match_start, @match_end); # get around scope limitations my %is_local; # value has been modified locally; VERY important! # state variable for user-defined use my %state; # get user name my $user; { my $pwent=getpwuid($EUID) or die "$prog: getpwuid $EUID: $!\n"; $user=$pwent->name; } # get group names my @groups; foreach my $gid (&unique(split /\s+/, $EGID)) { # get group numbers my $grent=getgrgid($gid) or die "$prog: group $gid has no name\n"; push @groups, $grent->name; } ($osname, $nodename, $osrelease)=POSIX::uname; $tags{n}=$nodename; $tags{s}=$osname; $tags{r}=$osrelease; my %do_type; my @original_ARGV=@ARGV; my $optstring="aAbd:D:Ef:FghiI:m:M:n:No:Op:rR:sSt:u:UvZ"; if (!getopts($optstring, \%opt)) { die &usage; } if ($opt{h}) { print &usage; &my_exit(0); } if ($opt{v}) { print "$version_string\n"; &my_exit(0); } # if daemon mode is enabled, we should also log any errors to syslog &daemon_mode_syslog_on if $opt{A}; $internal_info=$opt{I} if defined $opt{I}; if ($internal_info =~ m{^internal[\-\_]config$}) { seek(DATA, $data_start, 0); print while (defined($_=) && !m{^\=}); seek(DATA, $data_start, 0); &my_exit(0); } $VAR{__USE_MINIMAL_CONFIG}=1 if $opt{F}; $VAR{__NO_STD_INCLUDES} =1 if $opt{i}; if ($opt{D}) { my @vars=split(/\,/, $opt{D}); foreach my $var (@vars) { my $val=1; if ($var =~ s{^([^=]+)\=(.+)}{$1}) { $val=$2; } $VAR{$var}=$val; } } sub usage { return "Usage: $prog [-f config_file] [-n nodename] [-U] [-d days] [-a]\n". " [-m mail-address] [-M mail-prog] [-p pgp-type] [-s] [-S]\n". " [-t type_force] [-N] [-v] [-A] [-b days] [logsfiles. . .]\n". "\n". " -a show all logs, even old stuff\n". " -A daemon mode; real mode as a daemon\n". " -b back_days show back_days worth of logs in real/gui mode\n". " -d days-ago show only logs from this long ago (def.=1)\n". " -D var1,var2=val set preprocessor variables\n". " -f config_file read config_file for additional config\n". " -F use minimal default config\n". " -g gui mode (if available)\n". " -I categories output all categories and exit\n". " -I config_versions output all config versions and exit\n". " -I help show the other -I options\n". " -m mail-address mail output to this mail-address\n". " -M mail-prog set the mail program (default='Mail')\n". " -n nodename use 'nodename' for scanning syslogs\n". " -N process all nodenames\n". " -o output_file output to output_file\n". " -O with -o, also output to stdout\n". " -p pgp-type encrypt mail output in 'pgp-type' style\n". " -r 'real mode' for continuous output\n". " -s suppress running extra commands\n". " -S suppress output \"footer\"\n". " -t type_force force files to be type type_force\n". " -u unknownsdir use unknownsdir as the log source or output for -U\n". " -U write unknowns and exit\n". " -v version\n". ""; } $VAR{_CONFIG_FILE1}=$gui_mode_config_file if $opt{g} && -f $gui_mode_config_file && -r _; $VAR{_CONFIG_FILE2}=$opt{f} if exists $opt{f}; &config_parse(\*DATA, "internal-config", $config_scalar, $config_array, 0); # done reading in the config. Let's process it. my (@log_type_list, %log_scalar, %log_array); &import_config_vars($config_scalar, $config_array); umask oct $umask; # this group of option processing is in a deliberate order. Don't mess. $show_all=1 if defined $opt{a}; $real_mode=1 if defined $opt{r}; $gui_mode=1 if defined $opt{g}; $daemon_mode=1 if defined $opt{A}; $days_ago=0 if (($show_all || $real_mode || $gui_mode || $daemon_mode) && !exists $in_config{days_ago}) && !exists $opt{d}; $days_ago=$opt{d} if defined $opt{d}; # other options in alpha order $real_mode_backlogs=1 if defined $opt{b}; $debug=1 if defined $opt{E}; $mail_address=$opt{m} if defined $opt{m}; $mail_command=$opt{M} if defined $opt{M}; $nodename=$opt{n} if defined $opt{n}; $process_all_nodenames=1 if defined $opt{N}; $output_file=$opt{o} if defined $opt{o}; $output_file_and_stdout=1 if defined $opt{O}; $pgp_type=$opt{p} if defined $opt{p}; $remote_file=$opt{R} if defined $opt{R}; $suppress_commands=1 if defined $opt{s}; $suppress_footer=1 if defined $opt{S}; $type_force=$opt{t} if defined $opt{t}; $unknowns_dir=$opt{u} if defined $opt{u}; $unknowns_only=1 if defined $opt{U}; $daemon_mode_foreground=1 if defined $opt{Z}; if (@ARGV && !$remote_file) { @required_log_files=@ARGV; @optional_log_files=(); } $real_mode=1 if $gui_mode; $real_mode=1 if $daemon_mode; if ($remote_file) { @optional_log_files=($remote_file); $real_mode=1; $real_mode_output_format="%R\n"; } my ($day_start, $day_end, $is_multiday); if ($days_ago=~m{^(\d{4,}_\d{1,2}_\d{1,2})\-(\d{4,}_\d{1,2}_\d{1,2})$} || $days_ago=~m{^(\d+)-(\d+)$} ) { $day_start=$1; $day_end=$2; $is_multiday=1; } elsif ($real_mode && $days_ago !~ m{\-}) { $day_start=$days_ago; $day_end="today"; $is_multiday=1; } else { $day_start = $day_end = $days_ago; $is_multiday=0; } my $relday_start = &normalize2relday($day_start); my $relday_end = &normalize2relday($day_end); my @when_start = &relday2time($relday_start); my @when_end = &relday2time($relday_end); die "Start date must be before or on end date\n" if $relday_start < $relday_end; # if we don't know what domain we're in, let's figure it out. if (!defined $domain) { my $resolvfh=new FileHandle; if ($resolvfh->open(") { if (m{^\s*domain\s+([\w\.\-]+)\s*$}i) { $domain=$1; last; } } $resolvfh->close; } } # localize nodename if (defined $domain && !$leave_FQDNs_alone) { $nodename=~s{\.(${domain}|localdomain)$}{}; } $tags{n}=$nodename; $tags{s}=$osname; $tags{r}=$osrelease; my (%when); my ($evals, $filename_pats)=&build_log_stuff($config_scalar, $config_array); &build_event_tree; if ($internal_info) { my $do_exit=1; # assume we should exit unless we're sure if ($internal_info eq "evals") { foreach my $type (@log_type_list) { print "eval for $type is:\n"; my $i=1; print map(sprintf("%5d\t%s\n", $i++, $_), split("\n", $evals->{$type})); print "\n"; } } elsif ($internal_info =~ m{^eval:(.*)}) { my $type=$1; die "No such type '$type'\n" unless exists $evals->{$type}; print "eval for $type is:\n"; my $i=1; print map(sprintf("%5d\t%s\n", $i++, $_), split("\n", $evals->{$type})); print "\n"; } elsif ($internal_info eq "evals-only") { foreach my $type (@log_type_list) { print $evals->{$type}, "\n"; } } elsif ($internal_info eq "permissions") { print "read/write: ".($gui_mode_configure_disabled?"no":"yes")."\n"; } elsif ($internal_info eq "categories") { print map("$_\n", sort &unique(@categories)); } elsif ($internal_info eq "actions") { print map("$_\n", sort &unique(keys %actions)); } elsif ($internal_info eq "colors") { print map("$_\n", sort &unique(keys %colors)); } elsif ($internal_info eq "pats") { print map("$_\n", sort &unique(keys %pat)); } elsif ($internal_info eq "nothing" || $internal_info eq "null") { # do nothing at all. Used to check that the code is OK because # perl -c is a whole new command line. . . } elsif ($internal_info =~ m{^(config|file)[\-\_]versions$}) { print @config_versions; } elsif ($internal_info =~ m{^log[\-\_]files$}) { # do nothing now; we'll handle this later $do_exit=0; } elsif ($internal_info eq "patterns") { foreach my $type (@log_type_list) { print "patterns for $type are:\n"; print map("\t$_\n", @{$patterns{$type}}); } } elsif ($internal_info =~ m{^log[\-\_]types$}) { print map("$_\n", @log_type_list); } elsif ($internal_info eq "help") { print map("$_\n", sort qw( internal_config evals categories config_versions log_files log_types patterns nothing actions colors pats help )); } else { die "$prog: internal info type $internal_info is not known.\n"; } &my_exit(0) if $do_exit; } &run_evals; setpriority (0, $$, $priority) || die "$prog: setpriority $priority: $!\n" if $priority; eval { &sort_keys ($default_sort); }; die "default sort $default_sort gives an error: $@\n" if $@; if ($unknowns_dir) { die "$prog: -u isn't compatible with other output options\n" if $opt{o} || $opt{m} || $opt{p}; die "unknowns_dir must be a readable, executable directory\n" if -e $unknowns_dir && (!-d _ || !-r _ || !-x _); @required_log_files=glob("$unknowns_dir/*") if -e $unknowns_dir; } if ($real_mode) { die "$prog: -r/real_mode isn't compatible with -a/show_all\n" if $show_all; } if ($gui_mode) { # load Tk modules only if we're in GUI mode. Don't do this otherwise. my @modules=qw{Tk Tk::HList Tk::Event Tk::Wm Tk::Dialog Tk::ItemStyle Tk::FileSelect Tk::ROText Tk::Font Tk::ErrorDialog Tk::BrowseEntry Tk::NoteBook Tk::resizebutton Tk::Wm Tk::LabEntry Tk::Pane }; foreach my $module (@modules) { my $eval_string="use $module"; eval $eval_string; # trap any fatal errors die qq($prog with -g or gui_mode requires the $module module, which is \n). qq(generating an error. Are you sure it's installed?\n). qq(To see the error yourself, please run: perl -e "$eval_string"\n) if $@; } if ($daemon_mode) { warn "$prog: daemon mode isn't compatible with gui mode\n"; undef $daemon_mode; } &gui_mode_init; } # done configging. Let's rock. if ($real_mode) { &do_real_mode; die; # we should never reach this } else { #report mode &do_report_mode; # done looking at the log files. Let's run the usual commands. . . if (! $suppress_commands) { foreach my $command (@commands_to_run) { $command_output{$command}=qx($command); } } &report_mode_output; } &my_exit(0); # Fini. sub debug(@) { warn "@_\n" if $debug; } sub process_handle { my $filename=shift; my $handle=shift; my $type=&type($filename); die "$prog: Unknown type: $type\n" if ! exists $do_type{$type}; $do_type{$type}->($filename, $handle); } sub do_report_mode { # expand out any globs die "No log files specified!\n" unless @optional_log_files+@required_log_files>0; my @globbed_optional_log_files; foreach (@optional_log_files) { push @globbed_optional_log_files, glob($_); } @globbed_optional_log_files=grep(-r, @globbed_optional_log_files); die "none of the log files is readable!\n" unless @globbed_optional_log_files+@required_log_files>0; foreach my $file (@required_log_files) { die "can't open log file $file\n" unless -r $file; } my @log_files=@required_log_files? @required_log_files : @globbed_optional_log_files; # If it's too old, skip it right away. No test for too young, because a # recently modified file may contain old logs. @log_files=grep(-M $_ <= $relday_start+2, @log_files) unless $show_all && !$is_multiday; if ($internal_info =~ m{^log[\-\_]files$}) { print map("$_\n", @log_files); &my_exit(0); } # if someone hits interrupt, print out what we have $SIG{'INT'}=sub { print "\nInterrupt received, dumping output.\n\n"; &report_mode_output; warn "$prog: interrupt received, dumped output.\n"; &my_exit(0); }; # OK, let's actually look at the log files foreach my $file (@log_files) { my $fh=&open($file) || die; &process_handle($file, $fh); close $fh; } } sub do_real_mode { # initially, we're scanning through "old" logs (ie. not current.) $real_mode_bypass=1 if !$real_mode_backlogs; $real_mode_before_now=1; die "$prog: no files to watch!" unless @optional_log_files + @required_log_files; STDOUT->autoflush(1); #otherwise color stuff doesn't work right $real_mode_last_check_time=0; # ie. never # currently, required_log_files and optional_log_files are mutually # exclusive, but that could change. Let's avoid assumptions. foreach my $file (@optional_log_files) { $real_file_state{$file}{required}=0; } foreach my $file (@required_log_files) { $real_file_state{$file}{required}=1; } # daemon mode is a minor variant of real mode &daemon_mode_daemonize if $daemon_mode; # gui mode is a variant of real mode if ($gui_mode) { &real_mode_check_function; &Tk::MainLoop; &my_exit; } else { while (1) { &real_mode_check_function; sleep($real_mode_sleep_interval); } } die; # we should never reach here } sub real_mode_check_function { if (time-$real_mode_last_check_time>=$real_mode_check_interval) { $real_mode_last_check_time=time; foreach my $file (keys %real_file_state) { my $filename; if ($real_file_state{$file}{required}) { die "Unable to read required file $file\n" if !-r $file; $filename=$file; } else { # then we also need to glob the filename my @globbed=glob($file); @globbed=grep(-r, @globbed); # make sure files are readable if (!@globbed) { # nothing to read! if (exists $real_file_state{$file}{handle}) { my $handle=$real_file_state{$file}{handle}; my $name=$real_file_state{$file}{name}; &process_handle($name, $handle) while !$handle->eof; # loop for non-blocking $handle->close; delete $real_file_state{$file}{handle}; } next; } elsif (@globbed==1) { $filename=shift @globbed; } else { @globbed=sort modification_sort_helper @globbed; $filename=shift @globbed; if ($real_mode_before_now && $real_mode_backlogs) { foreach my $filename (reverse @globbed) { next if -M $filename > $relday_start + 2; my $handle=&open($filename); &process_handle($filename, $handle) while !$handle->eof; # loop for non-blocking $handle->close; } } } } my $oldhandle = $real_file_state{$file}{handle}; my $oldino = $real_file_state{$file}{ino}; my $newstat = stat $filename || die "$prog: stat $filename\n"; my $newino = $newstat->ino; if ($oldhandle) { # we have an open file. Is it current? if ($newino == $oldino) { # same file next; # we don't need to play with it. } else { # different file. Let's process the old one one last time # and then close it my $oldfilename=$real_file_state{$file}{name}; my $oldtype=$real_file_state{$file}{type}; &process_handle($oldfilename, $oldhandle) while !$oldhandle->eof; # loop for non-blocking $oldhandle->close; undef $real_file_state{$file}{handle}; } } # OK, we need to open this sucker. my $handle=&open($filename); $real_file_state{$file}{handle} = $handle; $real_file_state{$file}{name} = $filename; $real_file_state{$file}{ino} = $newino; } } foreach my $file (keys %real_file_state) { my $fh=$real_file_state{$file}{handle}; next if ! defined $fh; my $type=$real_file_state{$file}{type}; my $name=$real_file_state{$file}{name}; seek ($fh, 0, 1); # straight out of perldoc -f seek &process_handle($name, $fh); } $real_mode_bypass=0; if ($real_mode_before_now) { $real_mode_before_now=0; } if ($gui_mode) { # clear status indicator &gui_mode_status; # reschedule checking for data $gui_mode_main->after($real_mode_sleep_interval*1000, \&real_mode_check_function); } } sub modification_sort_helper { return -M $a <=> -M $b; } sub type { defined(my $file=shift) || die "Internal error"; return $type_of{$file} if exists $type_of{$file}; return $type_force if defined $type_force; # what log type is it? my @types=grep(&basename($file) =~ m{^$filename_pats->{$_}}, @log_type_list); die "no known log type for file $file\n" if ! @types; die "more than one type matches file $file: @types\n" if @types>1; my $type=$types[0]; $type_of{$file}=$type; return $type; } sub open_command { defined(my $file=shift) || die "Internal error"; defined(my $type=shift) || die "Internal error"; my $open_command; $open_command=$log_scalar{$type}{open_command} if $log_scalar{$type}{open_command}; my $pipe_decompress_to_open; $pipe_decompress_to_open=$log_scalar{$type}{pipe_decompress_to_open} if $log_scalar{$type}{pipe_decompress_to_open}; my $tmpfile=undef; # if we have both a decompression rule and we already have an open_command, # we need to worry about two commands. This shouldn't be a big deal -- # either we pipe the decompression output directly to the open command, or # if that won't work, we use a temp file. Default to the temp file, because # it's more likely to work; override by setting pipe_decompress_to_open to # true. if ($file =~ m{\.([^\.]+)$} && exists $decompression_rules{$1}) { if (!$open_command) { $open_command=$decompression_rules{$1}; $open_command=&process_tags($open_command, {%tags, f=>$file}); } elsif ($pipe_decompress_to_open) { my $command=&process_tags($decompression_rules{$1}, {%tags, f=>$file}); $open_command=&process_tags($open_command, {%tags, f=>"-"}); $open_command=$command." | ".$open_command; } else { # it would be nice if we could just assume that the open_command can # correctly handle input from a pipe on stdin. # Unfortunately, this is not the case for "last -f file" under # Solaris 2.6, OpenBSD 2.4, and various Linuxen. # So, we do temp file fun. my $command=&process_tags($decompression_rules{$1}, {%tags, f=>$file}); $tmpfile=&tmpnam; $command .= " >$tmpfile"; die "unable to run '$command'\n" unless !(system($command)/256); $open_command=&process_tags($open_command, {%tags, f=>$tmpfile}); } } elsif ($open_command) { # and no decompression applies $open_command=&process_tags($open_command, {%tags, f=>$file}); } return ($open_command, $tmpfile); } sub open { defined(my $file=shift) || die "Internal error"; my $type=&type($file); my ($open_command, $tmpfile)=&open_command($file, $type); my $fh=new FileHandle; if (! $open_command) { $fh->open("<$file") || die "$prog unable to open $file for reading: $!\n"; } else { $fh->open("$open_command|") || die "$prog: unable to run '$open_command': $!\n"; if ($log_scalar{$type}{open_command_is_continuous}) { if ($real_mode) { $fh->blocking(0) || die "$prog: set non-blocking on '$open_command': $!\n" } else { die "$prog: cannot use continuous command for type $type ". "except in real mode\n"; } } &rm_on_exit($tmpfile) if defined $tmpfile; } $multiplier{$file}=1; # init $incomplete{$file}=""; # init return $fh; } # given an array IN, return an array OUT consisting of the unique elements of IN sub unique { my @result; my %found; foreach my $elem (@_) { push @result, $elem unless $found{$elem}++; } return @result; } # given two array references in, return the set difference of A-B sub set_difference { my $A=shift; my $B=shift; my (%found, @result); @found{@$B}=(1) x @{$B}; foreach my $i (&unique(@$A)) { push @result, $i unless $found{$i}; } return @result; } # given two array references in, return the set intersection of A&B sub set_intersection { my $A=shift; my $B=shift; my (%found, @result); @found{@$B}=(1) x @{$B}; foreach my $i (&unique(@$A)) { push @result, $i if $found{$i}; } return @result; } # given a scalar E and an array ref A, return true if E is a member of A sub set_is_member { my $E=shift; my $A=shift; foreach my $i (@$A) { return 1 if $i eq $E; } return 0; } sub report_mode_output { $SIG{'INT'}='DEFAULT'; if ($unknowns_only) { if ($unknowns_dir) { if (-d $unknowns_dir) { system("rm -r $unknowns_dir"); die "$prog: rm -r $unknowns_dir: command failed\n" if $? >> 8; } die "No more unknowns!\n" if ! %unknowns; mkdir ($unknowns_dir, 0755) || die "$prog: mkdir $unknowns_dir: $!"; foreach my $type (sort keys %unknowns) { my $outfh=new FileHandle(">$unknowns_dir/$type") || die "$prog: open $unknowns_dir/$type: $!"; print $outfh sort keys %{$unknowns_raw{$type}}; close $outfh; } } foreach my $type (sort keys %unknowns) { print "\nType: $type\n\n"; print map($_."\n", sort keys %{$unknowns{$type}}); } return; } elsif ($show_all) { &report_mode_output_day($relday_end); } else { for (my $day=$relday_start; $day>=$relday_end; $day--) { &report_mode_output_day($day); } } } sub report_mode_output_day { defined(my $relday=shift) || die "$prog: missing arg"; my $date = strftime($date_format, &relday2time($relday)); my $date_start = strftime($date_format, @when_start); my $date_end = strftime($date_format, @when_end); my $output_message; my @output_commands; if (!$show_all) { $output_message=&process_tags($output_message_one_day, { %tags, d=>$date } ); } elsif (!$is_multiday) { $output_message=&process_tags($output_message_all_days, { %tags, d => $date } ); } else { $output_message=&process_tags($output_message_all_days_in_range, { %tags, s => $date_start, e => $date_end } ); } if ($output_file) { push @output_commands, "tee ". &process_tags($output_file, { %tags, d => $date } ); } if ($pgp_type) { die "Unknown PGP type: $pgp_type\n" unless defined $pgp_rules{$pgp_type}; my $pgp_command=&process_tags($pgp_rules{$pgp_type}, {%tags, m => $mail_address}); push @output_commands, $pgp_command; } if ($mail_address) { push @output_commands, &process_tags($mail_command, {%tags, m => $mail_address, o => $output_message }); } my $outfh; if (@output_commands) { my $output_command=join("|", @output_commands); if ($output_file && !$output_file_and_stdout) { $output_command.=" >/dev/null"; } $outfh=new FileHandle("|$output_command") || die "$prog: run $output_command: $!"; select $outfh; } print "\n$output_message\n\n"; if (! $suppress_commands) { foreach my $command (@commands_to_run) { print "$command output:\n$command_output{$command}\n" if exists $command_output{$command}; } } # process unique categories, derived categories, and ignore_categories foreach my $host (sort keys %{$count{$relday}}) { # unique categories my $unique_ref=$unique{$relday}{$host}; foreach my $category (keys %$unique_ref) { foreach my $item (keys %{$unique_ref->{$category}}) { my $count=scalar keys %{$unique_ref->{$category}{$item}}; $count{$relday}{$host}{$category}{$item}+=$count; } # apply filter if applicable my $filter=$categories{$category}{filter}; $filter=$default_filter if !defined $filter && defined $default_filter; my %values=%{$count{$relday}{$host}{$category}}; my @items=keys %values; @items=&filter($filter, %values) if (defined $filter); # delete stuff in delete_if_unique if applicable foreach my $item (@items) { foreach my $key (keys %{$unique_ref->{$category}{$item}}) { my $hashref=$unique_ref->{$category}{$item}{$key}; foreach my $l1 (keys %$hashref) { foreach my $l2 (keys %{$hashref->{$l1}}) { delete $count{$relday}{$host}{$l1}{$l2}; } } } } } # derived categories foreach my $category (keys %categories) { my $derive=$categories{$category}{derive}; next if !defined $derive; die "category $category should be derived, but was written to!\n" if defined $count{$relday}{$host}{$category}; %{$count{$relday}{$host}{$category}} = &derive($derive, $relday, $host); } # ignore_categories foreach my $category (@ignore_categories) { delete $count{$relday}{$host}{$category}; } } my %unknown_categories; @unknown_categories{@unknown_categories}=undef; my @categories_output=(@priority_categories, grep (!exists $unknown_categories{$_}, &unique(@categories)), @unknown_categories); # actually do the output thang if ($report_mode_combine_nodes) { foreach my $category (@categories_output) { &report_mode_output_category($relday, $nodename, $category); } print "\n"; } elsif ($report_mode_output_node_per_category) { foreach my $category (@categories_output) { foreach my $host (sort keys %{$count{$relday}}) { &report_mode_output_category($relday, $host, $category); } } print "\n"; } else { foreach my $host (sort keys %{$count{$relday}}) { print "\n\nLogs found for other hosts. For host $host:\n" if (keys %{$count{$relday}}) > 1 || ( (keys %{$count{$relday}}) == 1 && (keys(%{$count{$relday}}))[0] ne $nodename); foreach my $category (@categories_output) { &report_mode_output_category($relday, $host, $category) } print "\n"; } } # make sure everything got output foreach my $host (sort keys %{$count{$relday}}) { my @categories_leftover=keys %{$count{$relday}{$host}}; die "$prog: categories leftover for $host: @categories_leftover\n" if @categories_leftover; } if (! $suppress_footer) { print "Program was called as: $0 @original_ARGV\n"; print "version: $version_string\n"; print "Elapsed time (seconds): ", time-$time_start, "\n"; if (!&empty($memory_size_command)) { my $command=&process_tags($memory_size_command, {p=>$$}); my $memory_size=qx($command); $memory_size =~ s/^\s+//g; $memory_size =~ s/\s+$//g; $memory_size =~ s/\s+/ /g; print "Memory used: $memory_size\n"; } print "\n"; } close $outfh if @output_commands; return; } sub report_mode_output_category { my ($relday, $host, $category)=@_; { # most of the function is a bare loop so we can use next to go to the end my (@keys, %values, %nodes); if ($report_mode_combine_nodes) { foreach my $host (keys %{$count{$relday}}) { foreach my $key (keys %{$count{$relday}{$host}{$category}}) { if (!$report_mode_combine_is_partway) { $values{$key}+=$count{$relday}{$host}{$category}{$key}; push @{$nodes{$key}}, $host; } else { $values{"$key ($host)"}+= $count{$relday}{$host}{$category}{$key}; } } delete $count{$relday}{$host}{$category}; } } else { next unless defined $count{$relday}{$host}{$category}; %values=%{$count{$relday}{$host}{$category}}; } @keys=keys %values; my $filter=$categories{$category}{filter}; $filter=$default_filter if !defined $filter && defined $default_filter; my $sort=$categories{$category}{sort}; $sort=$default_sort if !defined $sort; @keys=&filter($filter, %values) if (defined $filter); @keys=&sort_keys($sort, \%values, @keys); next if !@keys; print "\n$category:"; print " (host $host)" if $report_mode_output_node_per_category && !$report_mode_combine_nodes; print " ($filter)" if defined $filter && $filter ne "none"; print "\n"; foreach my $key (@keys) { if (!$report_mode_combine_nodes || !$report_mode_combine_shows_nodes) { printf "%-10d %s\n", $values{$key}, $key } else { printf "%-10d %s (%s)\n", $values{$key}, $key, join(" ", sort @{$nodes{$key}}); } } } delete $count{$relday}{$host}{$category}; } sub real_mode_out { defined(my $relday = shift) || die "Internal error"; defined(my $entry_tags_ref = shift) || die "Internal error"; return if $real_mode_bypass; $entry_tags_ref->{A}=$entry_tags_ref->{R}."\n" if $keep_all_raw_logs; my $category=$entry_tags_ref->{c}; # side-effect if (!$real_mode_no_actions_unless_is_daemon || $daemon_mode ) { my $do_action=&config_check($entry_tags_ref, "do_action"); &do_action($do_action, $entry_tags_ref) if defined $do_action; } # output depends on mode return &gui_mode_out_hook($relday, $entry_tags_ref) if $gui_mode; return if $daemon_mode; # no output # regular real mode my $color=&config_check($entry_tags_ref, "color"); &color($color, 1) if $color; print &process_tags($real_mode_output_format, $entry_tags_ref); &color("normal", 1) if $color; } sub gui_mode_out_hook { defined(my $relday = shift) || die "Internal error"; defined(my $entry_tags_ref = shift) || die "Internal error"; my $host = $entry_tags_ref->{'h'}; my $count = $entry_tags_ref->{'#'}; my $category = $entry_tags_ref->{'c'}; my $data = $entry_tags_ref->{'d'}; return if &is_ignored($entry_tags_ref); if (exists $gui_mode_state{$host}{$category}{$data}) { my $hashref=$gui_mode_state{$host}{$category}{$data}; $hashref->{tags_ref}->{'#'}+=$count; $hashref->{tags_ref}->{A}.=$entry_tags_ref->{R}."\n" if $keep_all_raw_logs; $gui_mode_hlist->itemConfigure( $hashref->{entry}, 1, -text => $hashref->{tags_ref}->{'#'}, ); $gui_mode_hlist->bell if exists $hashref->{tags_ref}->{bell}; } else { my $entry=$gui_mode_hlist->addchild(""); # store metadata in internal structures my $hashref={}; $gui_mode_state{$host}{$category}{$data}=$hashref; $hashref->{tags_ref}=$entry_tags_ref; $hashref->{entry}=$entry; # given the entry, we want to be able to get the hashref $gui_mode_hashref{$entry}=$entry_tags_ref; # now actually draw the entry my $button=$gui_mode_hlist->Button( -bitmap => "error", -command => [\&gui_mode_entry_clear, $entry], ); $gui_mode_hlist->itemCreate($entry, 0, -itemtype => "window", -widget => $button); my $i=1; foreach my $tag ('#', 'h', 'c', 'd') { $gui_mode_hlist->itemCreate($entry, $i, -itemtype => "text", -text => $entry_tags_ref->{$tag}); $i++; } $gui_mode_total++; $gui_mode_unknowns++ if $entry_tags_ref->{_u}; &gui_mode_find_check($entry); &gui_mode_color($entry); } } # implement color for GUI mode sub gui_mode_color { my ($entry, $is_refresh)=@_; my $entry_tags_ref=$gui_mode_hashref{$entry}; my $color=&config_check($entry_tags_ref, "color") || ""; if (exists $entry_tags_ref->{color} && $entry_tags_ref->{color} eq $color) { return; } $entry_tags_ref->{color} = $color; delete $entry_tags_ref->{bell}; if (! exists $color2style{$color}) { my $style=$gui_mode_hlist->ItemStyle("text"); $color2style{$color}=$style; my @colors=split(/\s+/, $color); my @known_colors=qw/black red green yellow blue magenta cyan white/; my $known_colors=join("|", @known_colors); foreach (@colors) { if (m{^($known_colors)$}o) { $style->configure(-foreground=>$1); } elsif (m{^($known_colors)_bg$}o) { $style->configure(-background=>$1); } elsif ($_ eq "bell") { $color2bell{$color}=1; } elsif (exists $colors{$_}) { # valid for real mode, but not here, so do nothing } else { &gui_mode_user_error("Unknown color $_"); } } } my $style=$color2style{$color}; if (exists $color2bell{$color}) { $entry_tags_ref->{bell}=1; $gui_mode_hlist->bell if !$is_refresh; } my $columns=$gui_mode_hlist->cget('-columns'); for (my $col=1; $col<$columns; $col++) { $gui_mode_hlist->itemConfigure($entry, $col, -style=>$style); } } sub gui_mode_popup { my $entry=shift; warn "In gui_mode_popup\n" if $debug; my $hashref=$gui_mode_hashref{$entry}; my $host=$hashref->{h}; my $menu=$gui_mode_main->Menu(-tearoff=>0); $menu->command( -label => "Debug: Output hashref contents", -command => sub { print "\n\nEntry $entry\n\n"; foreach my $key (keys %{$gui_mode_hashref{$entry}}) { print "$key=${$gui_mode_hashref{$entry}}{$key}\n"; } }) if $debug; $menu->command( -label => "Clear this count and remove line", -command => [\&gui_mode_entry_clear, $entry]); $menu->command( -label => "Description of event", -command => [\&gui_mode_description, $entry]); $menu->command( -label => "Save event", -command => [\&gui_mode_save_event, $entry]); $menu->command( -label => "Print event", -command => [\&gui_mode_print, $entry]); $menu->command( -label => "Show first raw log entry", -command => [\&gui_mode_show, "%R\n", $entry]); $menu->command( -label => "Show all raw log entries", -command => [\&gui_mode_show, "%A", $entry], -state=> $keep_all_raw_logs? "normal" : "disabled"); $menu->command( -label => "Configure pattern", -command => [\&gui_mode_configure_event_pattern, $entry], &gui_mode_configure_state); $menu->command( -label => "Configure event", -command => [\&gui_mode_event_config, $entry], &gui_mode_configure_state); my $cascade=$menu->cascade(-tearoff=>0, -label => "Select events with selected. . ."); $cascade->command(-label=>"category", -command => [\&gui_mode_select_like, ["c"], $entry]); $cascade->command(-label=>"category and data", -command => [\&gui_mode_select_like, ["c", "d"], $entry]); $cascade->command(-label=>"host", -command => [\&gui_mode_select_like, ["h"], $entry]); $cascade->command(-label=>"category and host", -command => [\&gui_mode_select_like, ["c", "h"], $entry]); $cascade->command(-label=>"category, data, and host", -command => [\&gui_mode_select_like, ["c", "d", "h"], $entry]); $cascade=$menu->cascade(-tearoff=>0, -label => "Ignore events with selected. . .", &gui_mode_configure_state); $cascade->command(-label=>"category", -command => [\&gui_mode_ignore, ["c"], $entry]); $cascade->command(-label=>"category and data", -command => [\&gui_mode_ignore, ["c", "d"], $entry]); $cascade->command(-label=>"host", -command => [\&gui_mode_ignore, ["h"], $entry]); $cascade->command(-label=>"category and host", -command => [\&gui_mode_ignore, ["c", "h"], $entry]); $cascade->command(-label=>"category, data, and host", -command => [\&gui_mode_ignore, ["c", "d", "h"], $entry]); $menu->command( -label => "Login to $host", -command => [\&gui_mode_login, $entry]); my $c=$menu->cascade(-label => "Do action", -tearoff=>0); foreach my $action (sort keys %actions) { $c->command(-label => $action, -command => [\&gui_mode_do_action, $action, $entry]); } $menu->post($gui_mode_main->pointerxy); $menu->grab; } sub gui_mode_entry_clear { foreach my $entry (@_) { my $host=$gui_mode_hashref{$entry}{h}; my $category=$gui_mode_hashref{$entry}{c}; my $data=$gui_mode_hashref{$entry}{d}; die "$prog: internal error: no gui_mode_state for $host, $category, $data" if !exists $gui_mode_state{$host}{$category}{$data}; $gui_mode_hlist->delete("entry", $entry); $gui_mode_total--; $gui_mode_unknowns-- if $gui_mode_hashref{$entry}{_u}; delete $gui_mode_state{$host}{$category}{$data}; delete $gui_mode_hashref{$entry}; } &gui_mode_select_update; } sub gui_mode_do_action { my $action=shift; return &gui_mode_user_error("No such action: $action") if ! exists $actions{$action}; foreach my $entry (@_) { &do_action($action, $gui_mode_hashref{$entry}, 1); } } sub gui_mode_ignore { my $ignore_what_ref=shift; my @events=@_; foreach my $event (@events) { my $hashref=$gui_mode_hashref{$event}; my $eventref={}; $eventref->{val}{is_local}=1; $eventref->{val}{priority}="IGNORE"; push @event_config, $eventref; foreach my $what (@$ignore_what_ref) { $eventref->{$what}=$hashref->{$what}; } } &gui_mode_event_config_apply; } sub gui_mode_select_like { my $select_what_ref=shift; my @events=@_; my @entries=$gui_mode_hlist->info("children"); return if !@entries; foreach my $event (@events) { my $hashref=$gui_mode_hashref{$event}; ENTRY: foreach my $entry (@entries) { my $entry_hashref=$gui_mode_hashref{$entry}; foreach my $what (@$select_what_ref) { if (&empty($hashref->{$what}) or &empty($entry_hashref->{$what}) or $hashref->{$what} ne $entry_hashref->{$what}) { next ENTRY; } } $gui_mode_hlist->selectionSet($entry, $entry); } } &gui_mode_select_update; return; } # apply changes to the event tree to the live window sub gui_mode_event_config_apply { &build_event_tree; &gui_mode_config_dirty; foreach my $entry ($gui_mode_hlist->info("children")) { my $hashref=$gui_mode_hashref{$entry}; &gui_mode_color($entry, 1); &gui_mode_entry_clear($entry) if &is_ignored($hashref); } } sub config_check { my $hashref=shift; my $key=shift; my $ret; $ret=&event_config_helper($hashref, $key, \%event_tree) if %event_tree; return $ret if defined $ret; my $destref=$dests{$hashref->{_t}}{$hashref->{_p}}[$hashref->{_w}] if exists $hashref->{_p}; $ret=$destref->{$key} if defined $destref; return $ret if defined $ret; $ret=$categories{$hashref->{c}}{$key}; return $ret if defined $ret; return undef; } sub event_config_helper { my $hashref=shift; my $key=shift; my $posref=shift; return $posref->{val}{$key} if exists $posref->{val} && exists $posref->{val}{$key}; foreach my $tag (sort keys %{$posref}) { next if !exists $hashref->{$tag}; my $val=$hashref->{$tag}; next if !exists $posref->{$tag}{$val}; my $ret=&event_config_helper($hashref, $key, $posref->{$tag}{$val}); return $ret if defined $ret; } return undef; } sub is_ignored { my $hashref=shift; my $priority=&config_check($hashref, "priority"); return 0 if !defined $priority or uc $priority ne "IGNORE"; return 1; } sub gui_mode_window { my $name=shift; my $widget=shift; $name=~s{\b(\w)}{\U$1}g; my $window=$widget->Toplevel; $window->bind("<$gui_mode_modifier-w>"=>sub{$window->destroy}); $window->bind(""=>sub{$window->destroy}); $window->title("$appname / $name"); my $font=$gui_mode_main->Font(-size=>24); my $frame=$window->Frame(@frameargs); $frame->pack(@Ptef, -fill=>"x"); $frame->Label(-text=>$name, -font=>$font)->pack(@Ptnf, -anchor=>"n"); return $window; } sub gui_mode_show { my $format=shift; my @events=@_; my $window=&gui_mode_window("show logs", $gui_mode_main); my $text=$window->Scrolled(qw/ROText/); $text->pack(@Ptef); foreach my $event (@events) { $text->insert("end",&process_tags($format, $gui_mode_hashref{$event})); } $window->Button(-text=>"OK", -command=>sub{$window->destroy}) ->pack(-side=>"bottom"); } sub gui_mode_widget_format { my $window=shift; my $what=shift; my $varhashref=shift; my $varname=shift; my $frame=$window->Frame(@frameargs); # this will be an invisible frame on purpose. In particular, we want to # use gui_mode_variable_config to get the varref and update varhashref, # but we don't need the actual widget my $varref=&gui_mode_variable_config($frame, $varhashref, $varname); $frame=$window->Frame(@frameargs); $frame->Label(-text=>"$what in what format?")->pack(@Ptnf); $frame->Radiobutton(-text=>"$what in category, count, data format", -variable=>$varref, -value=>'%c\n%#\t%d\n')->pack(@Ptnf); $frame->Radiobutton(-text=>"$what first raw log entry per event", -variable=>$varref, -value=>'%R\n')->pack(@Ptnf); $frame->Radiobutton(-text=>"$what all raw log entries per event", -variable=>$varref, -value=>'%A', -state=> $keep_all_raw_logs? "normal" : "disabled", )->pack(@Ptnf); $frame->Label(-text=>"$what raw format:")->pack(@Plnf, -anchor=>"w"); $frame->Entry(-textvariable=>$varref)->pack(@Plef, -anchor=>"w", -fill=>"x"); return $frame; } sub gui_mode_widget_selected { my $window=shift; my $what=shift; my $varhashref=shift; my $varname=shift; my $frame=$window->Frame(@frameargs); # this will be an invisible frame on purpose. In particular, we want to # use gui_mode_variable_config to get the varref and update varhashref, # but we don't need the actual widget my $varref=&gui_mode_variable_config($frame, $varhashref, $varname); $frame=$window->Frame(@frameargs); $frame->Label(-text=>"$what selected entries or all entries?")->pack(@Ptnf); $frame->Radiobutton(-text=>"$what selected events", -variable=>$varref, -value=>0)->pack(@Ptni); $frame->Radiobutton(-text=>"$what all events", -variable=>$varref, -value=>1)->pack(@Ptni); return $frame; } sub gui_mode_widget_do_action { my $window=shift; my $varref=shift; my $frame=$window->Frame(@frameargs); $frame->Label(-text=>"What action do you want this to take?")->pack(@Ptef); $frame->Radiobutton(-text=>"No action", -val=>"", -variable=>$varref)->pack(@Ptni); $frame->Label(-text=>"Or pick one:" )->pack(@Plni); $frame->BrowseEntry(-variable=>$varref, -choices=>[keys %actions], -state=>"readonly", )->pack(@Plni); return $frame; } sub gui_mode_widget_description { my $window=shift; my $varref=shift; my $frame=$window->Frame(@frameargs); $frame->Label(-text=>"What description would you give this?")->pack(@Ptef); $frame->Entry(-textvariable=>$varref)->pack(@Ptef); return $frame; } sub gui_mode_widget_priority { my $window=shift; my $varref=shift; my $frame=$window->Frame(@frameargs); $frame->Label(-text=>"What priority should this be given?")->pack(@Ptef); $frame->Radiobutton(-text=>"No special priority", -val=>"", -variable=>$varref)->pack(@Ptni); foreach my $priority (reverse @priorities) { $frame->Radiobutton(-text=>$priority_name{$priority}, -val=>$priority, -variable=>$varref)->pack(@Ptni); } return $frame; } sub gui_mode_widget_color { my $window=shift; my $varref=shift; my %is_selected; my ($foreground, $background); my $config_sub = sub { $$varref=join(" ", grep $is_selected{$_}, sort keys %is_selected); $$varref.=" $foreground" if !&empty($foreground); $$varref.=" $background" if !&empty($background); $$varref=~s{^\s+}{}; $$varref=~s{\s\s+}{ }g; }; my @c=(-command=>$config_sub); my $frame=$window->Frame(@frameargs); my @colors=sort keys %colors; my @real_colors=grep(exists $colors{$_."_bg"}, @colors); my @non_colors=grep(!m{_bg$} && !exists $colors{$_."_bg"}, @colors); my %pre_selected; @pre_selected{split /\s+/, $$varref}=undef if defined $$varref; $is_selected{$_}=1 foreach (grep exists $pre_selected{$_}, @non_colors); $foreground=$_ foreach (grep exists $pre_selected{$_}, @real_colors); $background=$_."_bg" foreach (grep exists $pre_selected{$_."_bg"}, @real_colors); $frame->Label(-text=>"What color attributes should this have?") ->pack(@Ptef); my @frame; for (my $i=0; $i<3; $i++) { $frame[$i]=$frame->Frame; $frame[$i]->pack(@Plef); } foreach my $color (@non_colors) { $frame[0]->Checkbutton(-text=>$color, -variable=>\$is_selected{$color}, @c, )->pack(@Ptni); } $frame[1]->Radiobutton(-text=>"No foreground", -variable=>\$foreground, -val=>"", @c, )->pack(@Ptni); $frame[2]->Radiobutton(-text=>"No background", -variable=>\$background, -val=>"", @c, )->pack(@Ptni); foreach my $color (@real_colors) { $frame[1]->Radiobutton(-text=>"$color foreground", -variable=>\$foreground, -val=>$color, @c )->pack(@Ptni); $frame[2]->Radiobutton(-text=>"$color background", -variable=>\$background, -val=>$color."_bg", @c )->pack(@Ptni); } return $frame; } sub gui_mode_properties { my ($widget, $varref)=@_; my %localhash=%$varref; my $window=&gui_mode_window("properties", $widget); my $frame; $frame=$window->Frame; $frame->pack(@Ptef); &gui_mode_widget_priority($frame, \$localhash{priority})->pack(@Plef); &gui_mode_widget_color($frame, \$localhash{color})->pack(@Plef); $frame=$window->Frame; $frame->pack(@Ptef); &gui_mode_widget_do_action($frame, \$localhash{do_action}) ->pack(@Plef); &gui_mode_widget_description($frame, \$localhash{description}) ->pack(@Plef); my $ok_sub = sub { foreach (qw(do_action priority color description)) { if (!&empty($localhash{$_})) { $varref->{$_}=$localhash{$_}; } else { delete $varref->{$_}; } } $window->destroy; }; &gui_mode_widget_actions($window, OK => $ok_sub)->pack(-side=>"bottom"); $window->grab; $window->waitWindow; } sub gui_mode_widget_actions { my $window=shift; my @actions=@_; my $frame=$window->Frame(@frameargs); $frame->pack(@Ptef); my $is_first=1; while (@actions) { my $what=shift @actions; my $sub=shift @actions; my $button=$frame->Button(-text=>$what, -command => $sub); if ($is_first) { $button->configure(-default=>"active"); $window->bind("", $sub); } $button->pack(-side=>"left"); $is_first=0; } $frame->Button(-text=>"Cancel", -command => sub { $window->destroy}) ->pack(-side=>"right"); return $frame; } sub gui_mode_print { my @events=@_; my $window=&gui_mode_window("print", $gui_mode_main); my $varhashref={}; my $what="Print"; # print command my $frame=$window->Frame(@frameargs); $frame->pack(@Ptef); &gui_mode_variable_config($frame, $varhashref, "print_command"); # print all/selected &gui_mode_widget_selected($window, $what, $varhashref, "gui_mode_print_all") ->pack(@Ptef, -fill=>"x"); # print format &gui_mode_widget_format($window, $what, $varhashref, "print_format") ->pack(@Ptef, -fill=>"x"); # actions &gui_mode_widget_actions($window, $what, sub { &gui_mode_variable_done($varhashref); &gui_mode_print_helper($window, @events)}) ->pack(-side=>"bottom"); } sub gui_mode_print_helper { my $window=shift; my @entries=@_; # we do this here instead of in the original menu call because the # selection may have changed since the original menu was made @entries=$gui_mode_hlist->selectionGet if !@entries; if (!defined $print_command or $print_command eq "") { &gui_mode_user_error("No print command specified"); return; } elsif (!$gui_mode_print_all && !@entries) { &gui_mode_user_error("You said to print selected ". "events, but none were selected"); return; } my $printfd=new FileHandle("|$print_command"); if (!$printfd) { &gui_mode_user_error("$prog: run $print_command: $!\n"); return; } @entries=$gui_mode_hlist->info("children") if $gui_mode_print_all; foreach my $entry (@entries) { my $hashref=$gui_mode_hashref{$entry}; if (!defined $hashref) { warn "No hashref for entry $entry, class ".$entry->Class."\n"; next; } print $printfd &process_tags($print_format, $hashref); } close $printfd; $window->destroy; &gui_mode_config_dirty; } sub gui_mode_pattern_test { my ($line, $logtyperef, $patternref, $destsref, $match_widgetref, $match_vars_ref)=@_; my $problem; { # make this a bare loop so we can use last $problem="No logtype" if &empty($$logtyperef); last if !&empty($problem); $problem="No pattern" if &empty($$patternref); last if !&empty($problem); $problem=&gui_mode_pattern_helper_test($line, $patternref, $match_vars_ref); last if !&empty($problem); $problem=&dests_test($line, $logtyperef, $patternref, $destsref); } if (!&empty($problem)) { $$match_widgetref->configure(-bg=>"red", -text=>$problem); } else { $$match_widgetref->configure(-bg=>"green", -text=>"OK"); } } sub gui_mode_pattern_helper_test { my ($line, $patternref, $match_vars_ref)=@_; my $match_test=&pattern_test($$patternref, defined $line?$line:""); if ($match_test==0) { # all is good } elsif ($match_test==1) { return "Pattern does not match" if defined $line; return ""; } elsif ($match_test==-1) { return "Pattern is bad"; } else { die "$prog: unknown match_test: $match_test\n"; } # display match variables my $match_vars=""; for (my $i=1; $i<=$#match_end; $i++) { if (defined $match_end[$i]) { $match_vars.="\$$i = ". substr($line, $match_start[$i], $match_end[$i]-$match_start[$i])."\n"; } } debug "match vars ($#match_end):\n$match_vars"; $$match_vars_ref=$match_vars; return ""; } sub gui_mode_configure_event_pattern { my @entries=@_; my ($hashref, $logtype, $pattern, $line); if (@entries) { &gui_mode_user_error("Configuring pattern for first selected event") if @entries>1; my $entry=shift @entries; # entries can contain at most one item $hashref=$gui_mode_hashref{$entry}; } if ($hashref) { $logtype=$hashref->{_t} if !&empty($hashref->{_t}); $line =$hashref->{_l} if !&empty($hashref->{_l}); $pattern=$hashref->{_p} if !&empty($hashref->{_p}); } &gui_mode_configure_pattern($logtype, $pattern, $line); } sub gui_mode_configure_pattern { my ($oldlogtype, $oldpattern, $line)=@_; my ($pattern, @my_dests, $logtype, $match_vars, $is_local); my $window; my ($pattern_widget, $match_widget, $frame, $dests_frame); my ($suggest_sub, $validate_pattern_sub, $validate_logtype_sub); $logtype=$oldlogtype; # init if (!&empty($oldpattern)) { $pattern=$oldpattern; $is_local=$is_local{pattern}{$logtype}{$pattern}; my $destsref=$dests{$logtype}{$pattern}; for (my $which=0; $which<@$destsref; $which++) { my $destref=$destsref->[$which]; foreach my $key (keys %$destref) { my $val=$destref->{$key}; if ($key eq "dest") { if ($val=~m{^(UNIQUE|CATEGORY)\s+(.*)}) { $my_dests[$which]{dest_type}=$1; $my_dests[$which]{dest_category}=$2; } elsif ($val=~m{^(SKIP|LAST)$}) { $my_dests[$which]{dest_type}=$1; } else { $my_dests[$which]{dest_type}="CATEGORY"; $my_dests[$which]{dest_category}=$val; } next; } else { $my_dests[$which]{$key}=$val; } } } } elsif (defined $line && length $line) { $pattern=$line; $pattern=~s{\s*$}{}; $pattern=quotemeta($pattern); # dequote stuff that doesn't need quoting: $pattern=~s{\\( |:)}{$1}ig; @my_dests=({}); # init $is_local=1; # definitely, since we just made it } else { $pattern=""; @my_dests=({}); # init $is_local=1; # definitely, since we just made it } $suggest_sub=sub { if (!$pattern_widget->selectionPresent) { &gui_mode_user_error("Highlight a variable part of the pattern"); return; } # find the user selection my $first=$pattern_widget->index("sel.first"); my $last =$pattern_widget->index("sel.last"); warn "selection first=$first last=$last\n" if $debug; my $pattern_before=$pattern_widget->get; my $selection=substr($pattern_before, $first, $last-$first); $selection=~s{\\(.)}{$1}g; # dequote warn "selection=$selection\n" if $debug; # find canned subpatterns (AKA pats) that match the user selection my @relevant_pats; foreach my $pat (sort keys %pat) { if ($selection=~m{^$pat{$pat}$}) { push @relevant_pats, $pat; } } # let the user select a pattern my $selected_pat; my $menu=$window->Menu(-tearoff=>0); foreach my $pat (@relevant_pats) { $menu->radiobutton(-label=>$pat, -variable=>\$selected_pat); } $menu->separator; $menu->radiobutton(-label=>"None applicable, edit manually", -variable=>\$selected_pat, -value=>""); $menu->post($window->pointerxy); $menu->grab; $menu->waitVariable(\$selected_pat); warn "selected pattern = $selected_pat\n" if $selected_pat && $debug; # replace the user selection if applicable return if !defined $selected_pat or !length $selected_pat; die "Unknown pat selected\n" if ! exists $pat{$selected_pat}; $pattern_widget->selectionClear; $pattern_widget->delete($first, $last); $pattern_widget->insert($first, "(\$pat{$selected_pat})"); }; $validate_pattern_sub=sub{ my ($newpattern, $chars, $currentpattern, $index, $action)=@_; &gui_mode_pattern_test($line, \$logtype, \$newpattern, \@my_dests, \$match_widget, \$match_vars); return 1; }; $validate_logtype_sub=sub{ my ($newlogtype, $chars, $currentpattern, $index, $action)=@_; &gui_mode_pattern_test($line, \$newlogtype, \$pattern, \@my_dests, \$match_widget, \$match_vars); return 1; }; my $test_sub=sub { &gui_mode_pattern_test($line, \$logtype, \$pattern, \@my_dests, \$match_widget, \$match_vars); }; # actually build window and widgets $window=&gui_mode_window("Configure Pattern", $gui_mode_main); # Frame for match status widget $frame=$window->Frame(@frameargs); $frame->pack(@Ptxf); $frame->Label(-text=>"Pattern status:")->pack(@Plnf); $match_widget=$frame->Label; $match_widget->pack(@Plnf); # logtype selector $window->BrowseEntry(-label=>"Logtype", -textvariable=>\$logtype, -choices=>\@log_type_list, -validate=>"key", -validatecommand=>$validate_logtype_sub, -state=>defined($oldlogtype)?"disabled":"readonly", )->pack(@Ptxf); $window->Checkbutton( -text=>"save this pattern and dests when saving local changes", -variable=>\$is_local, )->pack(@Ptxf); # frame for line, if applicable if (defined $line && length $line) { $frame=$window->Frame(@frameargs); $frame->pack(@Ptxf); $frame->Scrolled("Label", -text=>"Line to match: $line")->pack(@Ptxf); } # frame: suggest $frame=$window->Frame(@frameargs); $frame->pack(@Ptxf); $frame->Button(-text=>"Suggest Subpattern. . .", -command=>$suggest_sub, )->pack(@Plnf); # frame: pattern $frame=$window->Frame(@frameargs); $frame->pack(@Ptxf); $frame->Label(-text=>"Pattern:")->pack(@Plnf); $pattern_widget=$frame->Scrolled("Entry", -textvariable=>\$pattern, -width=>$gui_mode_field_width{pattern}, -validate=>"key", -validatecommand=>$validate_pattern_sub, ); $pattern_widget->pack(@Plxf); # frame: unknown showing buttons $frame=$window->Frame(@frameargs); $frame->pack(@Ptnf); $frame->Button(-text=>"Show All Unknowns And Matches. . .", -command=> sub{&gui_mode_unknowns(\$logtype, \$pattern, 1)})->pack(@Plnf); $frame->Button(-text=>"Show Matching Unknowns. . .", -command=> sub{&gui_mode_unknowns(\$logtype, \$pattern)})->pack(@Plnf); $frame->Button(-text=>"Show All Unknowns. . .", -command=> sub{&gui_mode_unknowns(\$logtype)})->pack(@Plnf); # frame: match variables $frame=$window->Frame(@frameargs); $frame->pack(@Ptef) if !&empty($line); $frame->Label(-text=>"Match Variables:")->pack(@Ptnf); $frame->Label(-textvariable=>\$match_vars)->pack(@Ptnf); # frame for dests $frame=$window->Frame(@frameargs); $frame->pack(@Ptef); $frame->Label(-text=>"Destinations")->pack(@Ptxf); &gui_mode_dests_refresh(\@my_dests, \$dests_frame, \$frame, $test_sub); &gui_mode_widget_actions($window, Done=>[\&gui_mode_pattern_done, $window, \$oldlogtype, \$logtype, \$oldpattern, \$pattern, \@my_dests, \$is_local, $line], )->pack(-side=>"bottom"); } sub gui_mode_pattern_done { my ($window, $oldlogtyperef, $logtyperef, $oldpatternref, $patternref, $gui_destsref, $is_localref, $line)=@_; my $oldlogtype=$$oldlogtyperef; my $logtype=$$logtyperef; my $oldpattern=$$oldpatternref; my $pattern=$$patternref; my $is_local=$$is_localref; # sanity check for all sorts of broken things return &gui_mode_user_error("No Logtype Selected") if !defined $logtype or !length $logtype; return &gui_mode_user_error("Unknown logtype $logtype") if !set_is_member($logtype, \@log_type_list); return &gui_mode_user_error("Logtype does not match original line logtype") if defined $logtype && defined $oldlogtype && $logtype ne $oldlogtype; # validate the pattern return &gui_mode_user_error("No pattern specified") if !defined $pattern or !length $pattern; my $match_test=&pattern_test($pattern, defined $line?$line:""); if ($match_test==-1) { return &gui_mode_user_error("Pattern is bad!"); } elsif (defined $line && $match_test==1) { return &gui_mode_user_error("Pattern No Longer Matches"); } # validate the dests my $dests_test=&dests_test($line, $logtyperef, $patternref, $gui_destsref); return &gui_mode_user_error($dests_test) if !&empty($dests_test); # convert the GUI destsref to a real destsref, ie. merging dest_type and # dest_category, stripping out useless stuff, etc. my $real_destsref=&gui_dests_to_real_dests($gui_destsref); return &gui_mode_user_error("Unspecified destination error") if !defined $real_destsref; # apply new pattern to existing unknowns my $eval_string=&build_pattern_string($logtype, $pattern, $real_destsref, 1); debug "eval_string: \n$eval_string\n"; my @matches_to_clear; foreach my $entry ($gui_mode_hlist->info("children")) { my $hashref=$gui_mode_hashref{$entry}; next if not $hashref->{_u}; # if not an unknown, skip my $logtype =$hashref->{_t}; my $line =$hashref->{_l}; my $raw_line=$hashref->{R}; my $host =$hashref->{h}; $multiplier{__INTERNAL}=$hashref->{'#'}; local $_ =$line; next if $$logtyperef ne $logtype; # if it doesn't match, skip next if &pattern_test($pattern, $line)!=0; # if it doesn't match, skip eval "$eval_string"; debug "error: $@" if $@; return &gui_mode_user_error("got error from destinations") if $@; push @matches_to_clear, $entry; } &gui_mode_entry_clear(@matches_to_clear); # clear any relevant entries # delete old pattern, if necessary if (defined $oldpattern && length $oldpattern && defined $oldlogtype && length $oldlogtype) { debug "deleting old pattern"; return &gui_mode_user_error("Cannot find old pattern; already deleted?") if ! &set_is_member($oldpattern, $patterns{$oldlogtype}); return &gui_mode_user_error("Cannot find old dest; already deleted?") if ! exists $dests{$oldlogtype}{$oldpattern}; $patterns{$oldlogtype}=[&set_difference($patterns{$oldlogtype}, [$oldpattern])]; delete $dests{$oldlogtype}{$oldpattern}; } # add new pattern unshift @{$patterns{$logtype}}, $pattern; $dests{$logtype}{$pattern}=$real_destsref; # rebuild internal data structures ($evals, $filename_pats)=&build_log_stuff; &run_evals; # save is_local state $is_local{pattern}{$logtype}{$pattern}=$is_local; # if we got this far, all is well $window->destroy; &gui_mode_config_dirty; $gui_mode_types_redone=1; } sub gui_mode_dests_refresh { my @args=@_; # save them before messing with them my ($destsref, $widgetref, $parentwidgetref, $test_sub)=@_; $$widgetref->destroy if $$widgetref; $$widgetref=$$parentwidgetref->Scrolled("Canvas"); $$widgetref->pack(@Ptef); # this evil hack is required to get around the fact that validate # occurs BEFORE the new value is applied :( # what we do is we actually edit a dummy variable, and apply the change # to the real variable just before testing. # We can't just edit the real variable in-place and then put it back # because that makes Tk unhappy, and the Tk::Entry manpage specifically # says not to do that. my $test_entry_sub=sub { my ($varref, $newval, $chars, $currentpattern, $index, $action)=@_; debug "newval=$newval"; $$varref=$newval; &$test_sub; return 1; }; my $new_dest_sub=sub { my $dest=shift; splice @$destsref, $dest, 0, {}; &gui_mode_dests_refresh(@args); }; my $delete_dest_sub=sub { my $dest=shift; splice @$destsref, $dest, 1; &gui_mode_dests_refresh(@args); }; my $move_dest_sub=sub { my ($dest, $to)=@_; return &gui_mode_user_error("Cannot move to there") if ($to<0 or $to>$#{$destsref}); my ($item)=splice @$destsref, $dest, 1; splice @$destsref, $to, 0, $item; &gui_mode_dests_refresh(@args); }; $$widgetref->Label(-text=>"dests: ".scalar(@$destsref))->pack(@Ptnf) if $debug; my $dest_type_browse_sub=sub { my ($widgetsref, $browsewidget, $dest_type)=@_; return &gui_mode_user_error("$prog: unknown dest type: $dest_type") if !exists $dests_deactivate{$dest_type}; my $bg=$browsewidget->cget("-background"); foreach my $key (keys %$widgetsref) { next if $key eq "dest_type"; my $widget=$$widgetsref{$key}; my $deactivate=&set_is_member($key, $dests_deactivate{$dest_type}); print "decativate $key? $deactivate\n" if $debug; $widget->configure(-state=>$deactivate?"disabled":"normal", -background=>$deactivate?"grey":$bg); } &$test_sub; }; for (my ($dest)=0; $dest<@$destsref ;$dest++) { print "Doing dest: $dest\n" if $debug; my $destref=$destsref->[$dest]; my $destframe=$$widgetref->Frame(@frameargs); $destframe->pack(@Ptef); $destframe->Label(-text=>"Destination ".($dest+1))->pack(@Ptnf); # buttons my $buttonframe=$destframe->Frame(@simpleframe); $buttonframe->pack(@Plyf); $buttonframe->Button(-text=>"new dest (insert here)", -command=>[$new_dest_sub, $dest], )->pack(@Ptef); $buttonframe->Button(-text=>"delete", -command=>[$delete_dest_sub, $dest], )->pack(@Ptef); $buttonframe->Button(-text=>"move up", -command=>[$move_dest_sub, $dest, $dest-1], )->pack(@Ptef); $buttonframe->Button(-text=>"move down", -command=>[$move_dest_sub, $dest, $dest+1], )->pack(@Ptef); # entries my $dataframe=$destframe->Frame(@simpleframe); $dataframe->pack(@Plef); my %widgets; $widgets{dest_type}=$dataframe->BrowseEntry( -textvariable=>\$destref->{dest_type}, -label=>"Destination Type:", -choices=>[qw(CATEGORY SKIP LAST UNIQUE)], -browsecmd=>[$dest_type_browse_sub, \%widgets], -state=>"readonly", ); $widgets{dest_type}->pack(@Ptxf); # see comment for $test_entry_sub for why we do this my $dest_category_temp=$destref->{dest_category}; $widgets{dest_category}=$dataframe->BrowseEntry( -textvariable=>\$dest_category_temp, -label=>"Destination Category:", -validatecommand=>[$test_entry_sub, \$destref->{dest_category}], -browsecmd=>[$test_entry_sub, \$destref->{dest_category}], -validate=>"key", -choices=>[sort string_nocase_sort_helper @categories], ); $widgets{dest_category}->pack(@Ptxf); # see comment for $test_entry_sub for why we do this my $format_temp=$destref->{format}; $widgets{format}=$dataframe->LabEntry( -textvariable=>\$format_temp, -labelPack=>[-side=>"left"], -label=>"Format:", -validatecommand=>[$test_entry_sub, \$destref->{format}], -validate=>"key", ); $widgets{format}->pack(@Ptxf); # see comment for $test_entry_sub for why we do this my $count_temp=$destref->{count}; $widgets{count}=$dataframe->LabEntry( -textvariable=>\$count_temp, -labelPack=>[-side=>"left"], -label=>"Count:", -validatecommand=>[$test_entry_sub, \$destref->{count}], -validate=>"key", ); $widgets{count}->pack(@Ptxf); $widgets{use_sprintf}=$dataframe->Checkbutton( -text=>"Use sprintf", -variable=>\$destref->{use_sprintf}, -command=>$test_sub, ); $widgets{use_sprintf}->pack(@Ptxf); $widgets{delete_if_unique}=$dataframe->Checkbutton( -text=>"Delete if 'Unique' Correlation", -variable=>\$destref->{delete_if_unique}, -command=>$test_sub, ); $widgets{delete_if_unique}->pack(@Ptxf); &$dest_type_browse_sub(\%widgets, $widgets{dest_type}, $destref->{dest_type}) if !&empty($destref->{dest_type}); } $$widgetref->Button(-text=>"new dest (append)", -command=>[$new_dest_sub, $#{$destsref}+1], )->pack(@Ptnf); &$test_sub; } sub gui_mode_view_all_patterns { my $window=&gui_mode_window("patterns config", $gui_mode_main); my @gui_mode_pattern_column_headers= qw(delete dests summary logtype pattern); my $hlist; my ($select_sub, $refresh_sub, $delete_sub, $dests_sub, $logtype_to_view); $select_sub=sub{}; $dests_sub=sub { my ($logtype, $num)=@_; my $pattern=$patterns{$logtype}[$num]; &gui_mode_configure_pattern($logtype, $pattern, undef); &$refresh_sub; }; $delete_sub=sub { my ($logtype, $num)=@_; my $pattern=$patterns{$logtype}[$num]; splice(@{$patterns{$logtype}}, $num, 1); delete $dests{$logtype}{$pattern}; # rebuild internal data structures ($evals, $filename_pats)=&build_log_stuff; &run_evals; &$refresh_sub; }; $refresh_sub=sub{ return 1 if ! defined $hlist; $hlist->delete("all"); foreach my $logtype (sort keys %patterns) { next if (!&empty($logtype_to_view) && $logtype_to_view ne "all" && $logtype_to_view ne $logtype); for (my $i=0; $i<@{$patterns{$logtype}}; $i++) { my $pattern=$patterns{$logtype}[$i]; my $entry=$hlist->addchild(""); # "Delete" button my $button=$hlist->Button(-text=>"Delete", -command=>[$delete_sub, $logtype, $i]); $hlist->itemCreate($entry, 0, -itemtype=>"window", -widget=>$button); # "Properties" button $button=$hlist->Button(-text=>"Dests...", -command=>[$dests_sub, $logtype, $i]); $hlist->itemCreate($entry, 1, -itemtype=>"window", -widget=>$button); # logtype $hlist->itemCreate($entry, 3, -itemtype=>"text", -text=>$logtype); # pattern $hlist->itemCreate($entry, 4, -itemtype=>"text", -text=>$pattern); # "summary" label foreach my $destref (@{$dests{$logtype}{$pattern}}) { my $dest=$destref->{dest}; next if !defined $dest; next if $dest ne "SKIP" && $dest ne "LAST"; $hlist->itemCreate($entry, 2, -itemtype=>"text", -text=>$dest); } } } 1; }; # logtype selector $window->BrowseEntry(-label=>"Logtype", -textvariable=>\$logtype_to_view, -choices=>["all", @log_type_list], -validate=>"key", -validatecommand=>$refresh_sub, -state=>"readonly", )->pack(@Ptxf); # build the pattern selection widget $hlist=$window->Scrolled('HList', -header=>1, -columns => 5, -padx=>1, -pady=>1, -scrollbars => "se", -selectmode=>"single",, -width=>150, -height=>10, -command=>$select_sub); $hlist->pack(@Ptef); # put headers on the columns my $col=0; foreach my $name (@gui_mode_pattern_column_headers) { my $header=$hlist->resizeButton(-text=>$name, -column=>$col, -widget=>\$hlist); $hlist->header("create", $col, -itemtype=>"window", -widget=>$header); $hlist->columnWidth($col, -char=>$gui_mode_field_width{$name}); $col++; } # actions &gui_mode_widget_actions($window, Done => sub { $window->destroy }, "Refresh" => $refresh_sub, )->pack(-side=>"bottom"); # populate the pattern table &$refresh_sub; } sub gui_mode_event_config { # we can handle being passed 0 or 1 events. More than that is wasted. my @events=@_; my @properties=qw(priority color do_action description); my $col_matches=3; # columns before we start having properties my @matches=qw(host category data); # not just keys; we care about order my @match_tags=map $name2tag{$_}, @matches; my $window=&gui_mode_window("event config", $gui_mode_main); my ($hlist, %eventref, %user_event); my ($add_sub, $delete_sub, $select_sub, $refresh_sub, $reset_sub); my ($apply_sub, $find_match_sub, $properties_sub); # use the user selection to set the user_event fields $select_sub = sub { my $arg=shift; my $eventref=$eventref{$arg}; $user_event{$_}=$eventref->{$_} foreach (@match_tags); $user_event{val}{$_}=$eventref->{val}{$_} foreach (@properties); }; # reset the user's entry $reset_sub = sub { undef $user_event{$_} foreach (@match_tags); undef $user_event{val}{$_} foreach (@properties); }; # find if the matches for a given entry are already in another entry $find_match_sub = sub { EVENT: foreach my $eventref (@event_config) { foreach my $tag (keys %$eventref) { next if $tag eq 'val'; next EVENT if &empty($user_event{$tag}); next EVENT if $eventref->{$tag} ne $user_event{$tag}; } foreach my $tag (keys %user_event) { next if $tag eq 'val'; next if &empty($user_event{$tag}); next EVENT if !exists $eventref->{$tag}; # don't need to check for equality 'cuz we already did } return $eventref; # we have a winner! } return undef; }; # add the user's entry to the entry table $add_sub=sub{ return &gui_mode_user_error("Nothing to match") if !grep(!&empty($user_event{$_}), @match_tags); return &gui_mode_user_error("No properties") if !grep(!&empty($user_event{val}{$_}), @properties); return &gui_mode_user_error("This event is already configured") if &$find_match_sub; my %new_event; foreach (@match_tags) { $new_event{$_}=$user_event{$_} if !&empty($user_event{$_}); } foreach (@properties, "is_local") { $new_event{val}{$_}=$user_event{val}{$_} if !&empty($user_event{val}{$_}); } push @event_config, \%new_event; &$apply_sub; }; # call this when @event_config changes $apply_sub = sub { &gui_mode_event_config_apply; &$refresh_sub; }; $delete_sub = sub { my $entry=shift; $hlist->delete("entry", $entry); my $eventref=$eventref{$entry}; for (my $i=0; $i<@event_config; $i++) { if ($event_config[$i]==$eventref) { splice(@event_config, $i, 1); &$apply_sub; return; } } &gui_mode_user_error("Event has already been deleted"); &$refresh_sub; }; # refresh the event selection widget from the event_config array $refresh_sub = sub { $hlist->delete("all"); undef %eventref; foreach my $eventref (@event_config) { my $entry=$hlist->addchild(""); $eventref{$entry}=$eventref; # "Delete" button my $button=$hlist->Button(-text=>"Delete", -command=>[$delete_sub, $entry]); $hlist->itemCreate($entry, 0, -itemtype=>"window", -widget=>$button); # "Properties" button $button=$hlist->Button(-text=>"Properties...", -command=>[$properties_sub, $eventref]); $hlist->itemCreate($entry, 1, -itemtype=>"window", -widget=>$button); # local? checkbox $button=$hlist->Checkbutton(-width=>$gui_mode_field_width{"local"}, -variable=>\$eventref->{val}{is_local}); $hlist->itemCreate($entry, 2, -itemtype=>"window", -widget=>$button); # matches for (my $i=0; $i<@matches; $i++) { my $tag=$match_tags[$i]; next if !exists $eventref->{$tag}; my $val=$eventref->{$tag}; $hlist->itemCreate($entry, $i+$col_matches, -itemtype=>"text", -text=>$val); } } }; $properties_sub = sub { my $eventref=shift; $eventref->{val}={} if !defined $eventref->{val}; &gui_mode_properties($hlist, $eventref->{val}); &$apply_sub; }; # build the event selection widget $hlist=$window->Scrolled('HList', -header=>1, -columns => $col_matches + @matches, -padx=>1, -pady=>1, -scrollbars => "se", -selectmode=>"single", -width=>150, -height=>10, -command=>$select_sub); $hlist->pack(@Ptef); # put headers on the columns my $col=0; foreach my $name ("delete", "properties", "local?", @matches) { my $header=$hlist->resizeButton(-text=>$name, -column=>$col, -widget=>\$hlist); $hlist->header("create", $col, -itemtype=>"window", -widget=>$header); $hlist->columnWidth($col, -char=>$gui_mode_field_width{$name}); $col++; } # populate the event table &$refresh_sub; # build the user input area my $frame=$window->Frame(@frameargs); $frame->pack(@Ptef); $frame->Button(-text=>"Add", -command=>$add_sub, -width=>$gui_mode_field_width{"delete"}, -padx=>0, -pady=>0, )->pack(@Plef); $frame->Button(-text=>"Properties...", -command=>[$properties_sub, \%user_event], )->pack(@Plef); $frame->Checkbutton(-width=>$gui_mode_field_width{"local"}, -variable=>\$user_event{val}{is_local})->pack(@Plef); $user_event{val}{is_local}=1; foreach my $name (@matches) { my $tag=$name2tag{$name}; $frame->Entry(-width=>$gui_mode_field_width{$name}, -textvariable=>\$user_event{$tag}) ->pack(@Plef); } # If we've been passed a new event, put it in the add dialog to be added # If we've been passed a configured event, reconfigure it if (@events) { my $event=shift @events; my $hashref=$gui_mode_hashref{$event}; foreach my $name (@matches) { my $tag=$name2tag{$name}; $user_event{$tag}=$hashref->{$tag}; } my $eventref=&$find_match_sub; if ($eventref) { &$properties_sub($eventref); } } # actions &gui_mode_widget_actions($window, Done => sub { $window->destroy }, Apply=>$apply_sub, "Refresh Table" => $refresh_sub, "Reset add area" => $reset_sub, )->pack(-side=>"bottom"); } sub gui_mode_variable_config { my ($widget, $varhashref, $variable)=@_; my $frame=$widget->Frame->pack(@Ptef, -fill=>"x"); my $first_word=$variable; $first_word=~s{_.*}{}; my $last_word =$variable; $last_word =~s{.*_}{}; # find the type of value my $type="string"; # reasonable default if ($last_word eq "format") { $type="format"; } elsif ($last_word eq "file") { $type="file"; } elsif ($last_word eq "interval") { $type="int"; } elsif ($last_word eq "disabled") { $type="boolean"; } elsif ($first_word eq "suppress") { $type="boolean"; } elsif ($var2type{$variable}) { $type=$var2type{$variable}; } my $name=$variable; $name=~s{^[^\_]+_mode_}{}; $name=~s{_}{ }g; $name=$var2name{$variable} if exists $var2name{$variable}; $name.='?' if $type eq "boolean"; $name =~ s{^(.)}{\U$1}; my $real_varref; eval qq(\$real_varref=\\\$$variable); die "$@" if $@; my $temp_var=$$real_varref; my $temp_varref=\$temp_var; my $real_is_localref=\$is_local{var}{$variable}; my $temp_is_local=$is_local{var}{$variable}; # init my $temp_is_localref=\$temp_is_local; my $changesub_entry=sub{ my $proposed=shift; $temp_is_local=1 if $proposed ne $$real_varref; return 1; }; my $changesub_checkbutton=sub{ $temp_is_local=1 if $$real_varref xor $$temp_varref; }; # actual widgets if ($type eq "boolean") { $frame->Checkbutton(-text=>"$name", -variable=>$temp_varref, -command=>$changesub_checkbutton, )->pack(@Plnf); } elsif ($type eq "file") { $frame->Label(-text=>$name)->pack(@Plnf); $frame->Entry(-textvariable=>$temp_varref, -validate=>"key", -validatecommand=>$changesub_entry, )->pack(@Plxf); $frame->Button(-text=>"Browse...", -command => sub { my $file=$gui_mode_main->getSaveFile(-initialdir=>dirname($$temp_varref)); $$temp_varref=$file if defined $file && $file ne ""; })->pack(@Plnf); } else { $frame->Label(-text=>$name)->pack(@Plnf); $frame->Entry(-textvariable=>$temp_varref, -validate=>"key", -validatecommand=>$changesub_entry, )->pack(@Plef, -fill=>"x"); } $frame->Checkbutton(-text=>"local?", -variable=>$temp_is_localref, )->pack(@Prnf); $varhashref->{$variable}{type}=$type; $varhashref->{$variable}{real_varref}=$real_varref; $varhashref->{$variable}{temp_varref}=$temp_varref; $varhashref->{$variable}{real_is_localref}=$real_is_localref; $varhashref->{$variable}{temp_is_localref}=$temp_is_localref; return $temp_varref; } sub gui_mode_variable_done { my $varhashref=shift; my $is_dirty=0; foreach my $variable (keys %$varhashref) { my $real_varref=$varhashref->{$variable}{real_varref}; my $real_is_localref=$varhashref->{$variable}{real_is_localref}; my $temp_varref=$varhashref->{$variable}{temp_varref}; my $temp_is_localref=$varhashref->{$variable}{temp_is_localref}; if (&val_or_empty($$real_varref) ne &val_or_empty($$temp_varref)) { $is_dirty=1; $$real_varref = $$temp_varref; } if ($$real_is_localref xor $$temp_is_localref) { $is_dirty=1; $$real_is_localref = $$temp_is_localref; } } &gui_mode_config_dirty if $is_dirty; } sub gui_mode_misc_configurables { my $window=&gui_mode_window("misc configurables", $gui_mode_main); my $NoteBook=$window->NoteBook; $NoteBook->pack(@Ptef); my $varhashref={}; my (%frame, %is_mode); foreach my $mode_name (qw{Core Report Real GUI Daemon}) { my $mode=lc $mode_name; $is_mode{$mode}=1 if $mode ne "core"; my $page=$NoteBook->add($mode, -label => $mode eq "core"? $mode_name : "$mode_name Mode"); $frame{$mode}=$page->Frame->pack(@Ptef); } my %var2mode; $var2mode{$_}="report" foreach (qw(other_host_message output_message_one_day output_message_all_days output_message_all_days_in_range mail_address mail_command output_file output_file_and_stdout default_sort default_filter)); $var2mode{$_}="gui" foreach (qw(default_login_action print_format print_command save_format window_command)); foreach my $scalar (@required_import_scalars, @optional_import_scalars) { my $first_word=$scalar; $first_word=~s{_.*}{}; # find the mode this belongs in my $mode="core"; # reasonable default if ($is_mode{$first_word}) { $mode=$first_word; next if $scalar eq $mode."_mode"; } elsif ($var2mode{$scalar}) { $mode=$var2mode{$scalar}; } my $window=$frame{$mode}; &gui_mode_variable_config($window, $varhashref, $scalar); } &gui_mode_widget_actions($window, "OK" => sub { &gui_mode_variable_done($varhashref); $window->destroy; })->pack(-side=>"bottom"); } sub gui_mode_find_dialog { my $window=&gui_mode_window("find", $gui_mode_main); my ($outerframe, $innerframe); my %find_what=%gui_mode_find_what; # init foreach my $what (qw(c d h)) { $outerframe=$window->Frame(@frameargs); $outerframe->pack(@Ptxf); $innerframe=$outerframe->Frame; # being used for layout. no args $innerframe->pack(@Ptxf); $innerframe->Label(-text=>$tag2name{$what})->pack(@Plnf); $innerframe->Entry(-textvariable=>\$find_what{$what}{val}, )->pack(@Plef); $innerframe=$outerframe->Frame; # being used for layout. no args $innerframe->pack(@Ptxf); $innerframe->Checkbutton(-text=>"case sensitive?", -variable=>\$find_what{$what}{iscase})->pack(@Plnf); $innerframe=$outerframe->Frame; # being used for layout. no args $innerframe->pack(@Ptxf); $find_what{$what}{regex_type}=0 if &empty($find_what{$what}{regex_type}); $innerframe->Radiobutton(-text=>"literal", -value=>0, -variable=>\$find_what{$what}{regex_type})->pack(@Plnf); $innerframe->Radiobutton(-text=>"glob", -value=>1, -variable=>\$find_what{$what}{regex_type})->pack(@Plnf); $innerframe->Radiobutton(-text=>"regex", -value=>2, -variable=>\$find_what{$what}{regex_type})->pack(@Plnf); } $outerframe=$window->Frame(@frameargs); $outerframe->pack(@Ptxf); $find_what{unknowns_type}=0 if &empty($find_what{unknowns_type}); $outerframe->Radiobutton(-text=>"unknowns only", -value=>2, -variable=>\$find_what{unknowns_type})->pack(@Plnf); $outerframe->Radiobutton(-text=>"knowns only", -value=>1, -variable=>\$find_what{unknowns_type})->pack(@Plnf); $outerframe->Radiobutton(-text=>"unknowns and knowns", -value=>0, -variable=>\$find_what{unknowns_type})->pack(@Plnf); &gui_mode_widget_actions($window, Done =>[\&gui_mode_find_done, $window, \%find_what], Apply=>[\&gui_mode_find_apply, \%find_what], Clear=>[\&gui_mode_find_clear, \%find_what], )->pack(-side=>"bottom"); } sub gui_mode_find_apply { my $hashref=shift; %gui_mode_find_what=%$hashref; my @all_entries=$gui_mode_hlist->info("children"); foreach my $entry (@all_entries) { &gui_mode_find_check($entry); } } sub gui_mode_find_check { my @entries=(@_); my $unknowns_type=$gui_mode_find_what{unknowns_type}; return unless %gui_mode_find_what; ENTRY: foreach my $entry (@entries) { my $match=1; # init my $hashref=$gui_mode_hashref{$entry}; CHECKS: { # bare loop so we can exit early if ($unknowns_type == 1 && $hashref->{_u}) { # users wants knowns and this is unknown $match=0; next CHECKS; } elsif ($unknowns_type == 2 && !$hashref->{_u}) { # user wants unknowns and this is known $match=0; next CHECKS; } WHAT: foreach my $what (qw(c d h)) { my $testval=$gui_mode_find_what{$what}{val}; next WHAT if &empty($testval); my $iscase=$gui_mode_find_what{$what}{iscase}; my $regex_type=$gui_mode_find_what{$what}{regex_type}; # modify the testval for the regex type if (!$regex_type) { # 0=literal $testval=quotemeta $testval; } elsif ($regex_type == 1) { # 1=glob $testval=~s{([^\w\?\*])}{\$1}g; $testval=~s{\?}{.}g; $testval=~s{\*}{.*}g; } elsif ($regex_type == 2) { # 2=regex # nothing special needs to be done } else { die "$prog: impossible value of regex_type: $regex_type"; } # determine the regex case flag from $iscase my $caseflag=$iscase ? "" : "i"; my $val=$hashref->{$what}; if ($val!~m{(?$caseflag:$testval)}) { $match=0; next CHECKS; } } } # done CHECKS if ($match) { next if !$gui_mode_hlist->info("hidden", $entry); # already unhidden $gui_mode_hlist->show("entry", $entry); $gui_mode_hidden--; } else { next if $gui_mode_hlist->info("hidden", $entry); # already hidden $gui_mode_hlist->selectionClear($entry, $entry); $gui_mode_hlist->hide("entry", $entry); $gui_mode_hidden++; } } } sub gui_mode_find_done { my ($window, $hashref)=@_; &gui_mode_find_apply($hashref); $window->destroy; } sub gui_mode_find_clear { my $find_what_ref=shift; undef %gui_mode_find_what; &gui_mode_unhide_all; return if !defined $find_what_ref; $find_what_ref->{unknowns_type}=0; foreach my $what (qw(c d h)) { $find_what_ref->{$what}{val}=""; $find_what_ref->{$what}{iscase}=0; $find_what_ref->{$what}{regex_type}=0; } } sub gui_mode_save_event { my @events=@_; my $what="Save"; my $varhashref={}; my $window=&gui_mode_window("save", $gui_mode_main); my $frame=$window->Frame(@frameargs); $frame->pack(@Ptef, -fill=>"x"); &gui_mode_variable_config($window, $varhashref, "gui_mode_save_events_file"); # save all/selected &gui_mode_widget_selected($window, $what, $varhashref, "gui_mode_save_all") ->pack(@Ptef, -fill=>"x"); # save format &gui_mode_widget_format($window, $what, $varhashref, "save_format") ->pack(@Ptef, -fill=>"x"); # actions &gui_mode_widget_actions($window, $what, sub { &gui_mode_variable_done($varhashref); &gui_mode_save_event_helper($window, @events); })->pack(-side=>"bottom"); } sub gui_mode_save_event_helper { my $window=shift; my @entries=@_; # the rest # we do this here instead of in the original menu call because the # selection may have changed since the original menu was made @entries=$gui_mode_hlist->selectionGet if !@entries; if (!defined $gui_mode_save_events_file or $gui_mode_save_events_file eq "") { &gui_mode_user_error("No save file specified"); return; } elsif (!$gui_mode_save_all && !@entries) { &gui_mode_user_error("You said to save selected ". "events, but none were selected"); return; } if (-f $gui_mode_save_events_file) { my $dialog=$gui_mode_main->Dialog(-bitmap=>"question", -text=>"File $gui_mode_save_events_file exists. Overwrite?", -default_button=>"Yes", -buttons=>["Yes", "No"]); my $result=$dialog->Show; return if $result ne "Yes"; } my $savefd=new FileHandle("> $gui_mode_save_events_file"); if (!$savefd) { &gui_mode_user_error("$prog: open $gui_mode_save_events_file for write: $!\n"); return; } @entries=$gui_mode_hlist->info("children") if $gui_mode_save_all; foreach my $entry (@entries) { my $hashref=$gui_mode_hashref{$entry}; if (! defined $hashref) { warn "No hashref for entry $entry, class ".$entry->Class."\n"; next; } print $savefd &process_tags($save_format, $hashref); } close $savefd; $window->destroy; &gui_mode_config_dirty; } sub gui_mode_config_dirty { $config_is_dirty=1; &config_save if $gui_mode_config_autosave; } sub gui_mode_save_config { my $should_wait=shift; return if $gui_mode_configure_disabled; my $window=&gui_mode_window("save config", $gui_mode_main); my $varhashref={}; my $frame=$window->Frame(@frameargs); $frame->pack(@Ptef); &gui_mode_variable_config($frame, $varhashref, "gui_mode_config_autosave"); &gui_mode_variable_config($frame, $varhashref, "gui_mode_config_savelocal"); &gui_mode_variable_config($frame, $varhashref, "gui_mode_config_save_does_rcs"); $frame=$window->Frame(@frameargs); $frame->pack(@Ptef); &gui_mode_variable_config($frame, $varhashref, "gui_mode_config_file"); &gui_mode_widget_actions($window, "Save", sub { &gui_mode_variable_done($varhashref); &config_save; $window->destroy; })->pack(-side=>"bottom"); if ($should_wait) { $window->grab; $window->waitWindow; } } sub do_rcs { my $file=shift; my $command=&process_tags($rcs_command, {%tags, f => $file}); system($command)==0 or &gui_mode_user_warn("RCS command failed on $file"); } sub config_save { # mode variables should be suppressed to avoid problems with a # config being used for multiple modes my %mode_vars=(gui_mode=>1, real_mode=>1); if ($gui_mode_config_save_does_rcs && -e $gui_mode_config_file) { &do_rcs($gui_mode_config_file); } my $savefd=new FileHandle($gui_mode_config_file, "w") || die "$prog: open $gui_mode_config_file for write: $!\n"; my $oldfd=select $savefd; print "# this file automatically generated by $version_string\n"; print "config_version $current_version\n\n"; foreach my $varname (@required_import_scalars, @optional_import_scalars) { my $value; my $is_local=$is_local{var}{$varname}; my $local=""; $local="local " if $is_local; eval "\$value=\$$varname"; next if $gui_mode_config_savelocal && !$is_local; if (exists $mode_vars{$varname}) { print "# mode variables are not saved\n"; print "#${local}set var $varname=\n\n"; } elsif (defined $value) { print "${local}set var $varname=$value\n\n"; } else { print "#${local}set var $varname=\n\n"; } } foreach my $varname (@required_import_arrays, @optional_import_arrays) { my @value; my $is_local=$is_local{arr}{$varname}; my $local=""; $local="local " if $is_local; eval "\@value=\@$varname"; next if $gui_mode_config_savelocal && !$is_local; if (@value) { print "${local}set arr $varname=\n", map ("\t$_\n",@value),"\n\n"; } else { print "#${local}set arr $varname=\n\n"; } } foreach my $varname (@arrays_to_become_hashes) { my %value; my $is_local=$is_local{arr}{$varname}; my $local=""; $local="local " if $is_local; eval "\%value=\%$varname"; next if $gui_mode_config_savelocal && !$is_local; if (%value) { print "${local}set arr $varname=\n", map ("\t$_, $value{$_}\n", sort keys %value), "\n\n"; } else { print "#${local}set arr $varname=\n\n"; } } print "\n# actions:\n\n"; foreach my $action (sort keys %actions) { my $is_local=$is_local{action}{$action}; my $local=""; $local="local " if $is_local; next if $gui_mode_config_savelocal && !$is_local; print "${local}action: $action\n"; foreach my $field (sort keys %{$actions{$action}}) { print "\t$field:\t$actions{$action}{$field}\n"; } print "\n"; } print "\n# categories:\n\n"; foreach my $category (sort keys %categories) { my $is_local=$is_local{category}{$category}; my $local=""; $local="local " if $is_local; next if $gui_mode_config_savelocal && !$is_local; print "${local}category: $category\n"; foreach my $field (sort keys %{$categories{$category}}) { print "\t$field:\t$categories{$category}{$field}\n"; } print "\n"; } print "\n# event config:\n\n"; &config_print_event_tree(\%event_tree, "event:\n"); print "\n# patterns:\n\n"; foreach my $logtype (sort keys %patterns) { foreach my $varname (@per_log_required_scalar_exts, @per_log_optional_scalar_exts) { my $fullvarname=$logtype."_".$varname; my $is_local=$is_local{var}{$fullvarname}; my $local=""; $local="local " if $is_local; next if $gui_mode_config_savelocal && !$is_local; if (exists $log_scalar{$logtype}{$varname}) { my $value=$log_scalar{$logtype}{$varname}; print "${local}set var $fullvarname=$value\n\n"; } else { print "#${local}set var $fullvarname=\n\n"; } } foreach my $varname (@per_log_required_array_exts, @per_log_optional_array_exts) { my $fullvarname=$logtype."_".$varname; my $is_local=$is_local{arr}{$fullvarname}; my $local=""; $local="local " if $is_local; next if $gui_mode_config_savelocal && !$is_local; if (exists $log_array{$logtype}{$varname}) { my @value=@{$log_array{$logtype}{$varname}}; print "${local}set arr $fullvarname=\n", map ("$_\n", @value), "\n\n"; } else { print "#${local}set arr $fullvarname=\n\n"; } } print "logtype:\t$logtype\n"; foreach my $pattern (@{$patterns{$logtype}}) { my $is_local=$is_local{pattern}{$logtype}{$pattern}; my $local=""; $local="local " if $is_local; next if $gui_mode_config_savelocal && !$is_local; print "\t${local}pattern:\t$pattern\n"; foreach my $destref (@{$dests{$logtype}{$pattern}}) { print "\n"; # weird functions here to make sure dest is printed last foreach my $field (reverse unique("dest", keys %$destref)) { print "\t\t$field:\t$destref->{$field}\n"; } print "\n"; } print "\n"; } print "\n"; } close $savefd; if ($gui_mode_config_save_does_rcs && -e $gui_mode_config_file) { &do_rcs($gui_mode_config_file); } select $oldfd; $config_is_dirty=0; } sub config_print_event_tree { my $posref=shift; my $string=shift; return if !defined $posref; if (exists $posref->{val}) { my $is_local=$posref->{val}{is_local}; my $local=""; $local="local " if $is_local; unless ($gui_mode_config_savelocal && !$is_local) { print "${local}$string"; foreach my $key (sort keys %{$posref->{val}}) { next if $key eq "is_local"; print "\t$key: \t$posref->{val}{$key}\n"; } print "\n"; } } foreach my $tag (sort keys %{$posref}) { next if $tag eq 'val'; foreach my $val (sort keys %{$posref->{$tag}}) { my $tag_name=$tag2name{$tag}; &config_print_event_tree($posref->{$tag}{$val}, $string."\tmatch $tag_name: \t$val\n"); } } } sub gui_mode_backlogs { my $window=&gui_mode_window("backlogs", $gui_mode_main); my $my_real_mode_backlogs=$real_mode_backlogs; my $scale_val=$relday_start; my $major_label; my $scale; my $active_sub = sub { my $state=$my_real_mode_backlogs? "normal" : "disable"; $scale->configure(-state=>$state); }; $window->Radiobutton(-text=>"Show no backlogs, just new things", -variable=>\$my_real_mode_backlogs, -value=>0, -command=>$active_sub, )->pack(-anchor=>"nw"); $window->Radiobutton(-text=>"Show backlogs", -variable=>\$my_real_mode_backlogs, -value=>1, -command=>$active_sub, )->pack(-anchor=>"nw"); $major_label=$window->Label( -text=>"How many days back of backlogs do you want?"); $major_label->pack; my $label=$window->Label(-text =>strftime($date_format, localtime(time-$scale_val*86400))); $label->pack; $scale=$window->Scale(qw/-orient horizontal -length 6i/, -command=>sub { $scale_val=$scale->get; $label->configure(-text =>strftime($date_format, localtime(time-$scale_val*86400))); }); $scale->set($scale_val); $scale->pack; &$active_sub; &gui_mode_widget_actions($window, "Restart with above setting", sub { &gui_mode_backlogs_helper($scale_val, $my_real_mode_backlogs) }) ->pack(qw/-expand 1 -fill x/); } sub gui_mode_backlogs_helper { $days_ago=shift; $real_mode_backlogs=shift; &gui_mode_exit_hook or return; $opt{d}=$days_ago; if ($real_mode_backlogs) { $opt{b}=1; } else { delete $opt{b}; delete $opt{d}; } my @new_ARGV; my $my_optstring=$optstring; while ($my_optstring =~ s{^([^:])(:?)}{}) { my $opt=$1; my $takes_arg=$2; next if ! exists $opt{$opt}; if ($takes_arg) { push @new_ARGV, "-$opt", $opt{$opt}; } else { push @new_ARGV, "-$opt"; } } push @new_ARGV, @ARGV; # arguments that remained after opt processing exec ($0, @new_ARGV); } sub gui_mode_resize_fields { my $window=&gui_mode_window("resize fields", $gui_mode_main); for (my $i=1; $i<@gui_mode_headers; $i++) { my $which=$i; # this is necessary to make the closure work my $frame=$window->Frame(@frameargs); my $header=$gui_mode_headers[$which]; my $label=$frame->Label(-text=>$header, -width=>10); my $scale; $scale=$frame->Scale(-orient=>"horizontal", -length=>"6i", -to=>200, -command=>sub{ my $val=$scale->get; $gui_mode_field_width{$header}=$val; $gui_mode_hlist->columnWidth($which, -char=>$val); } ); $scale->set($gui_mode_field_width{$header}); my @pl=qw/-side left -anchor w/; $frame->pack(-side=>"top"); $label->pack(@pl); $scale->pack(@pl); } my $frame=$window->Frame(@frameargs); $frame->pack(-expand=>1, -fill=>"x"); $frame->Button(-text=>"OK", -command=>sub{$window->destroy})->pack(-side=>"left"); $frame->Button(-text=>"Cancel", -command=>sub{$window->destroy})->pack(-side=>"right"); } sub gui_mode_restart { &gui_mode_exit_hook or return; exec ($0, @original_ARGV); } sub gui_mode_exit_hook { if ($config_is_dirty && !$gui_mode_configure_disabled) { my $ok; my $window=&gui_mode_window("exit", $gui_mode_main); $window->Label(-text=>"The config has not been saved!")->pack(@Ptef); &gui_mode_widget_actions($window, "Exit anyway" => sub {$window->destroy; $ok=1}, "Save config" => sub {&gui_mode_save_config(1); if (!$config_is_dirty) {$window->destroy; $ok=1} }, )->pack(@Ptef); $window->grab; $window->waitWindow; return 0 if !$ok; } #mta $gui_mode_main->destroy; # should we bother? It can take a long time return 1; } sub gui_mode_exit { &my_exit(0); } sub gui_mode_toggle_pause { $gui_mode_paused=!$gui_mode_paused; &gui_mode_status_paused; } sub my_exit { my $exit_code=shift; &gui_mode_exit_hook or return if $gui_mode; exit $exit_code if defined $exit_code; exit 0; } sub gui_mode_unknowns { my ($logtyperef, $patternref, $show_non_matches)=@_; my ($requested_logtype, $pattern); $requested_logtype=$$logtyperef if defined $logtyperef; $pattern=$$patternref if defined $patternref; my $title="Unknowns"; $title="Unknown matches" if !&empty($pattern); $title="Unknown matches and non-matches" if !&empty($pattern) && $show_non_matches; $title.=" for type $requested_logtype" if !&empty($requested_logtype); my $window=&gui_mode_window($title, $gui_mode_main); my $text=$window->Scrolled(qw/ROText -wrap none/); $text->pack(@Ptef); $window->Button(-text=>"OK", -command=>sub{$window->destroy}) ->pack(-side=>"bottom"); # get the unknowns my %unknowns; my @entries=$gui_mode_hlist->info("children"); foreach my $entry (@entries) { my $hashref=$gui_mode_hashref{$entry}; next if not $hashref->{_u}; my $logtype=$hashref->{_t}; my $line =$hashref->{_l}; push @{$unknowns{$logtype}}, $line if &empty($requested_logtype) or $requested_logtype eq $logtype; } # display the unknowns foreach my $logtype (sort keys %unknowns) { $text->insert("end", "$title (logtype $logtype):\n"); foreach my $line (sort @{$unknowns{$logtype}}) { if (not defined $pattern) { # it's easy, just add it $text->insert("end", "\t$line\n"); } else { my $match_test=&pattern_test($pattern, $line); if (!$show_non_matches) { if ($match_test==0) { $text->insert("end", "\t$line\n"); } } else { if ($match_test==0) { my $index=$text->index("end"); $text->tagConfigure("match", -foreground=>"white", -background=>"black"); $text->insert("end", "\t$line\n", "match"); } else { $text->insert("end", "\t$line\n"); } } } } $text->insert("end", "\n"); } } # returns 0 for match, 1 for no match, -1 for error sub pattern_test { my ($pattern, $line)=@_; my $ret=1; eval "\$ret=0 if \$line=~m{^$pattern".'\s*$}; '. '@match_start=@-; @match_end=@+'; $ret=-1 if $@; return $ret; } sub dests_test { my ($line, $logtyperef, $patternref, $gui_destsref)=@_; my ($logtype, $pattern)=($$logtyperef, $$patternref); my $dests_validate=&dests_validate($gui_destsref); return $dests_validate if $dests_validate; # if there is no logtype or no pattern, we have bigger problems return "No logtype" if &empty($logtype); return "No pattern" if &empty($pattern); # no other tests work unless we have a line. :( return "" if &empty($line); my $pattern_test=&pattern_test($pattern, $line); return "Pattern does not match" if $pattern_test == 1; return "Pattern is bad" if $pattern_test == -1; my $real_destsref=&gui_dests_to_real_dests($gui_destsref); return "Unspecified destination error" if !defined $real_destsref; my $eval_string=&build_pattern_string($logtype, $pattern, $real_destsref, 1, 1); debug "eval_string: \n$eval_string\n"; my $raw_line="__UNKNOWN"; my $host ="__UNKNOWN"; $multiplier{__INTERNAL}=1; local $_ =$line; eval "$eval_string"; debug "error: $@" if $@; return "got error from destinations" if $@; return undef; # if we get this far, all appears well } # correct dests, ie. rejoin dest_type and dest_category, strip out # empties, strip out stuff that isn't applicable sub gui_dests_to_real_dests { my $gui_destsref=shift; my $real_destsref; foreach my $gui_destref (@$gui_destsref) { my $real_destref={}; my $dest_type=$gui_destref->{dest_type}; return undef if !defined $dest_type; return undef if !exists $dests_deactivate{$dest_type}; # cleanup keys that aren't applicable or are empty foreach my $key (keys %$gui_destref) { next if &set_is_member($key, $dests_deactivate{$dest_type}); next if &empty($gui_destref->{$key}); $real_destref->{$key}=$gui_destref->{$key}; } # join dest_category and dest_type and save as "dest". my $dest_category=$gui_destref->{dest_category}; delete $real_destref->{dest_type}; delete $real_destref->{dest_category}; my $dest=$dest_type; $dest.=" $dest_category" if defined $dest_category && length $dest_category; $real_destref->{dest}=$dest; push @$real_destsref, $real_destref; } return $real_destsref; } sub dests_validate { my ($destsref)=@_; my $num_dests=@$destsref; my $unique_seen=0; return "No dests present" if !$num_dests; for (my $i=0; $i<$num_dests; $i++) { my $d="Destination ".($i+1); my $destref=$destsref->[$i]; my $dest_type=$destref->{dest_type}; return "$d: missing Destination Type" if &empty($dest_type); return "$d: unknown dest_type $dest_type" if !exists $dests_minimum{$dest_type}; return "$d: $dest_type must be the only destination if present" if $num_dests>1 && ($dest_type eq "SKIP" or $dest_type eq "LAST"); $unique_seen=1 if $dest_type eq "UNIQUE"; return "$d: any CATEGORY dest must be before any UNIQUE dest" if $dest_type eq "CATEGORY" && $unique_seen; foreach my $key (@{$dests_minimum{$dest_type}}) { return "$d: missing required parameter $key" if !defined $destref->{$key} or not length $destref->{$key}; } } return undef; # if we get this far, all appears well } sub gui_mode_description { my $window=&gui_mode_window("description of events", $gui_mode_main); my $text=$window->Scrolled(qw/ROText -wrap word/); $text->pack(@Ptef); foreach my $entry (@_) { my $hashref=$gui_mode_hashref{$entry}; my $event_string=&process_tags("$real_mode_output_format", $hashref); $text->insert("end", "Event:\n"); $text->insert("end", "$event_string\n\n"); my $description = &config_check($hashref, "description"); $description = "no description for this event in the config" if !defined $description; $text->insert("end", "Event description:\n"); $text->insert("end", "$description\n\n\n\n"); } $window->Button(-text=>"OK", -command=>sub{$window->destroy}) ->pack(-side=>"bottom"); } sub gui_mode_login { foreach my $entry (@_) { my $host=$gui_mode_hashref{$entry}{h}; return &gui_mode_user_error("Cannot log in because no login method is ", "defined in the config. Either set default_login_action or add a line ", "for this host to login_action.") if !$default_login_action && !exists $login_action{$host}; my $action=$default_login_action; $action=$login_action{$host} if exists $login_action{$host}; &gui_mode_do_action($action, $entry); } } sub gui_mode_user_error { my $message="@_"; $gui_mode_main->Dialog(-text=>$message, -bitmap=>"error", -title=>"Error", -buttons=>["Acknowledge"])->Show; } sub gui_mode_user_warn { my $message="@_"; $gui_mode_main->Dialog(-text=>$message, -bitmap=>"info", -title=>"Warning", -buttons=>["Acknowledge"])->Show; } sub gui_mode_configure_state { return (-state=> "disabled") if $gui_mode_configure_disabled; return (-state=> "normal"); } sub gui_mode_init { $gui_mode_main=Tk::MainWindow->new; $gui_mode_main->title("$appname / main"); my $menuframe=$gui_mode_main->Frame(@frameargs); $menuframe->pack(qw/-expand 0 -side top -fill x/); my ($m, $c); # menu, cascade my @m_pack=qw/-side left -expand 0 -fill x/; $m=$menuframe->Menubutton(qw/-text File -tearoff 0 -underline 0/); $m->command(-label => '~Save config...', -command => \&gui_mode_save_config, &gui_mode_configure_state); $m->checkbutton(-label => '~Autosave config', -variable => \$gui_mode_config_autosave, -command => sub { $is_local{var}{gui_mode_config_autosave}=1; &gui_mode_config_dirty; }, &gui_mode_configure_state); $m->checkbutton(-label => "~Pause", -variable=>\$gui_mode_paused, -command=>\&gui_mode_status_paused, -accelerator=>"$gui_mode_modifier+Space"); $gui_mode_main->bind("<$gui_mode_modifier-space>"=>\&gui_mode_toggle_pause); $m->command(-label => '~Backlogs...', -command => \&gui_mode_backlogs); $m->separator; $m->command(-label => '~Restart', -command => \&gui_mode_restart); $m->command(-label => '~Close', -command => \&gui_mode_exit, -accelerator=>"$gui_mode_modifier+W"); $gui_mode_main->bind("<$gui_mode_modifier-w>" => \&gui_mode_exit); $m->command(-label => '~Quit', -command => \&gui_mode_exit, -accelerator=>"$gui_mode_modifier+Q"); $gui_mode_main->bind("<$gui_mode_modifier-q>" => \&gui_mode_exit); $m->pack(@m_pack); $m=$menuframe->Menubutton(qw/-text Edit -tearoff 0 -underline 1/); $m->command(-label => 'Select ~All', -command=>\&gui_mode_select_all, -accelerator=>"$gui_mode_modifier+A"); $gui_mode_main->bind("<$gui_mode_modifier-a>" => \&gui_mode_select_all); $m->command(-label => 'Select Unknowns', -command=>\&gui_mode_select_unknowns); $m->command(-label => 'Select Knowns', -command=>\&gui_mode_select_knowns); $m->command(-label => '~Unselect All', -command=>\&gui_mode_unselect_all); $m->separator; $m->command(-label => '~Find', -command=>\&gui_mode_find_dialog, -accelerator=>""); $gui_mode_main->bind("" => \&gui_mode_find_dialog); $m->command(-label => '~Clear Find', -command=>\&gui_mode_find_clear); $m->pack(@m_pack); $m=$menuframe->Menubutton(qw/-text View -tearoff 0 -underline 0/); $m->pack(@m_pack); $m->command(-label => '~Hide Selected', -command => \&gui_mode_hide_events); $m->command(-label => 'Hide Unselected', -command => [\&gui_mode_hide_events, 1]); $m->command(-label => '~Unhide All', -command => \&gui_mode_unhide_all); $m->separator; $m->command(-label => '~Resize Fields...', -command => \&gui_mode_resize_fields); $m->command(-label => "~Patterns...", -command => \&gui_mode_view_all_patterns, &gui_mode_configure_state); $m->command(-label => "~Event Config...", -command => \&gui_mode_event_config, &gui_mode_configure_state); $m->command(-label => "~Misc configurables...", -command => \&gui_mode_misc_configurables, &gui_mode_configure_state); $m=$menuframe->Menubutton(qw/-text Event -tearoff 0 -underline 0/); $m->pack(@m_pack); my $sub= sub { &gui_mode_entry_clear($gui_mode_hlist->selectionGet) }; $m->command( -label => "~Clear counts and remove items", -command => $sub, -accelerator=>"$gui_mode_modifier+C", ); $gui_mode_main->bind("<$gui_mode_modifier-c>" => $sub); $m->command(-label => "~Description of events", -command => sub { &gui_mode_description($gui_mode_hlist->selectionGet); }); $m->command(-label => "~Save Events", -command => sub { &gui_mode_save_event }); $sub = sub { &gui_mode_print }; $m->command(-label => "~Print Events", -command => $sub , -accelerator=>"$gui_mode_modifier+P",); $gui_mode_main->bind("<$gui_mode_modifier-p>" => $sub); $m->command(-label => "Show first raw log entry per event", -command => sub { &gui_mode_show("%R\n", $gui_mode_hlist->selectionGet)}); $m->command(-label => "Show all raw log entries per event", -command => sub { &gui_mode_show("%A", $gui_mode_hlist->selectionGet)}, -state=>$keep_all_raw_logs? "normal" : "disabled" ); $m->command(-label => "Configure pattern", -command => sub { &gui_mode_configure_event_pattern( $gui_mode_hlist->selectionGet)}, &gui_mode_configure_state); $m->command(-label => "Configure event", -command => sub { &gui_mode_event_config( $gui_mode_hlist->selectionGet)}, &gui_mode_configure_state); my $cascade=$m->cascade(-label => "~Select Events with selected. . .", -tearoff=>0, &gui_mode_configure_state); $cascade->command(-label => "category", -command => sub { &gui_mode_select_like(["c"], $gui_mode_hlist->selectionGet)}); $cascade->command(-label => "category and data", -command => sub { &gui_mode_select_like(["c", "d"], $gui_mode_hlist->selectionGet)}); $cascade->command(-label => "host", -command => sub { &gui_mode_select_like(["h"], $gui_mode_hlist->selectionGet)}); $cascade->command(-label => "category and host", -command => sub { &gui_mode_select_like(["c", "h"], $gui_mode_hlist->selectionGet)}); $cascade->command(-label => "category, data, and host", -command => sub { &gui_mode_select_like(["c", "d", "h"], $gui_mode_hlist->selectionGet)}); $cascade=$m->cascade(-label => "~Ignore Events with selected. . .", -tearoff=>0, &gui_mode_configure_state); $cascade->command(-label => "category", -command => sub { &gui_mode_ignore(["c"], $gui_mode_hlist->selectionGet)}); $cascade->command(-label => "category and data", -command => sub { &gui_mode_ignore(["c", "d"], $gui_mode_hlist->selectionGet)}); $cascade->command(-label => "host", -command => sub { &gui_mode_ignore(["h"], $gui_mode_hlist->selectionGet)}); $cascade->command(-label => "category and host", -command => sub { &gui_mode_ignore(["c", "h"], $gui_mode_hlist->selectionGet)}); $cascade->command(-label => "category, data, and host", -command => sub { &gui_mode_ignore(["c", "d", "h"], $gui_mode_hlist->selectionGet)}); $m->command(-label => "~Login to hosts", -command => sub { &gui_mode_login($gui_mode_hlist->selectionGet); }); $c=$m->cascade(-label => "~Do action on events", -tearoff=>0); foreach my $action (sort keys %actions) { $c->command(-label=>$action, -command => sub { &gui_mode_do_action( $action, $gui_mode_hlist->selectionGet); } ); } $m=$menuframe->Menubutton(qw/-text Help -tearoff 0 -underline 0/); $m->pack(@m_pack, -side => "right"); $m->command(-label => "About", -command => sub { &gui_mode_about }); $gui_mode_hlist=$gui_mode_main->Scrolled( 'HList', -scrollbars => 'se', -columns => scalar @gui_mode_headers, -header => 1, -width => 150, -height => 10, -padx => 0, -pady => 0, -selectmode => "extended", -command => \&gui_mode_popup, -browsecmd => \&gui_mode_select_update, ); $gui_mode_hlist->pack(@Ptef); for (my $i=0; $i<@gui_mode_headers; $i++) { my $name=$gui_mode_headers[$i]; my $header=$gui_mode_hlist->resizeButton(-text=>$name, -column=>$i, -widget=>\$gui_mode_hlist); $gui_mode_hlist->header("create", $i, -itemtype=>"window", -widget=>$header); $gui_mode_hlist->columnWidth($i, -char => $gui_mode_field_width{$name}); } $gui_mode_hlist->columnWidth(0, ""); $gui_mode_hlist->header("create", 0, qw/-itemtype imagetext -bitmap error/); my $statusbar=$gui_mode_main->Frame(@frameargs); $statusbar->pack(qw/-expand 0 -side top -fill x/); my $pausebutton=$statusbar->Checkbutton(-text=>"Pause", -variable=>\$gui_mode_paused, -command=>\&gui_mode_status_paused, -relief=>"raised", -borderwidth=>2); $pausebutton->pack(-side=>"left", -expand=>0, -fill=>"x"); my $total_frame=$statusbar->Frame(@frameargs)->pack(@Plnf); $total_frame->Label(-text=>"total:")->pack(@Plnf); $total_frame->Label(-textvariable=>\$gui_mode_total)->pack(@Plnf); my $unknown_frame=$statusbar->Frame(@frameargs)->pack(@Plnf); $unknown_frame->Label(-text=>"unknowns:")->pack(@Plnf); $unknown_frame->Label(-textvariable=>\$gui_mode_unknowns)->pack(@Plnf); my $selected_frame=$statusbar->Frame(@frameargs)->pack(@Plnf); $selected_frame->Label(-text=>"selected:")->pack(@Plnf); $selected_frame->Label(-textvariable=>\$gui_mode_selected)->pack(@Plnf); my $hidden_count_frame=$statusbar->Frame(@frameargs)->pack(@Plnf); $hidden_count_frame->Label(-text=>"hidden:")->pack(@Plnf); $hidden_count_frame->Label(-textvariable=>\$gui_mode_hidden)->pack(@Plnf); my $statuslabel=$statusbar->Label(-textvariable=>\$gui_mode_status, -justify=>"left"); $statuslabel->pack(@Plnf); } # update gui_mode_selected when selection changes sub gui_mode_select_update { my @selected_entries=$gui_mode_hlist->selectionGet; $gui_mode_selected=scalar @selected_entries; } sub gui_mode_about { my $window=&gui_mode_window("about", $gui_mode_main); $window->Label(-text=>"$version_string")->pack(@Ptef); my $frame=$window->Frame(@frameargs); $frame->pack(@Ptef); my $URLcopy=$URL; $frame->Label(-text=>"URL:")->pack(@Plnf); $frame->Entry(-textvariable=>\$URLcopy)->pack(@Plef); my $text=$window->Scrolled(qw/ROText -wrap none/); $text->pack(@Ptef); $text->insert("end", "Authors:\n\n"); my $fh=new FileHandle; $fh->open("<$authorsfile") or die "$prog: open $authorsfile: $!\n"; while (defined($_=<$fh>)) { $text->insert("end", " ".$_); } close $fh; $window->Button(-text=>"OK", -command=>sub{$window->destroy}) ->pack(-side=>"bottom"); } sub gui_mode_select_all { my @entries=$gui_mode_hlist->info("children"); return if !@entries; my $from = shift @entries; my $to = $from; $to=pop @entries if @entries; $gui_mode_hlist->selectionSet($from, $to); &gui_mode_select_update; return; } sub gui_mode_unselect_all { my @entries=$gui_mode_hlist->info("children"); return if !@entries; my $from = shift @entries; my $to = $from; $to=pop @entries if @entries; $gui_mode_hlist->selectionClear($from, $to); &gui_mode_select_update; return; } sub gui_mode_select_unknowns { my @entries=$gui_mode_hlist->info("children"); return if !@entries; foreach my $entry (@entries) { my $hashref=$gui_mode_hashref{$entry}; if ($$hashref{_u}) { $gui_mode_hlist->selectionSet($entry, $entry); } } &gui_mode_select_update; return; } sub gui_mode_select_knowns { my @entries=$gui_mode_hlist->info("children"); return if !@entries; foreach my $entry (@entries) { my $hashref=$gui_mode_hashref{$entry}; if (!$$hashref{_u}) { $gui_mode_hlist->selectionSet($entry, $entry); } } &gui_mode_select_update; return; } # by default, hide all selected events. If you set hide_unselected, hides all # unselected events sub gui_mode_hide_events { my $hide_unselected=shift; my @selected_entries=$gui_mode_hlist->selectionGet; my @hide_entries; if (!$hide_unselected) { @hide_entries=@selected_entries; } else { my @all_entries=$gui_mode_hlist->info("children"); @hide_entries=&set_difference(\@all_entries, \@selected_entries); } foreach my $entry (@hide_entries) { next if $gui_mode_hlist->info("hidden", $entry); # already hidden $gui_mode_hlist->selectionClear($entry, $entry); $gui_mode_hlist->hide("entry", $entry); $gui_mode_hidden++; } &gui_mode_select_update; } sub gui_mode_unhide_all { my @all_entries=$gui_mode_hlist->info("children"); foreach my $entry (@all_entries) { $gui_mode_hlist->show("entry", $entry); } $gui_mode_hidden=0; } sub gui_mode_status { my $state=shift; if (defined $state) { $gui_mode_status=$state; if (!$gui_mode_busy) { $gui_mode_main->Busy; $gui_mode_busy=1; } } else { if (!$gui_mode_paused) { $gui_mode_status="Ready"; } else { $gui_mode_status="Paused"; } if ($gui_mode_busy) { $gui_mode_main->Unbusy; $gui_mode_busy=0; } } $gui_mode_main->update; } sub gui_mode_status_scanning { my $now=time; if ($now - $gui_mode_status_updated >= 1) { &gui_mode_status("Scanning files" . " ." x (1 + $now % 3)); $gui_mode_status_updated=$now; } } # call when there's been a change in pause status sub gui_mode_status_paused { if ($gui_mode_paused) { $gui_mode_status="Paused"; $gui_mode_main->waitVariable(\$gui_mode_paused); } $gui_mode_status="Resumed"; } sub do_action { my $action=shift; my $entry_tags_ref=shift; my $force=shift; if (! exists $actions{$action}) { warn "$prog: no such action: $action\n"; return; } my $action_format = $default_action_format; $action_format = $actions{$action}{action_format} if exists $actions{$action}{action_format}; my $throttle; $throttle=$actions{$action}{throttle} if exists $actions{$action}{throttle}; my $throttle_format = $default_throttle_format; $throttle_format = $actions{$action}{throttle_format} if exists $actions{$action}{throttle_format}; my $message = &process_tags($action_format, $entry_tags_ref); my $throttle_key = &process_tags($throttle_format, $entry_tags_ref); return if !$force && defined $throttle && &throttle($throttle, $throttle_key); my $command=&process_tags($actions{$action}{command}, $entry_tags_ref); if (exists $actions{$action}{window}) { my $title=&process_tags($actions{$action}{window}, $entry_tags_ref); return warn "$prog: action $action needs a window, but window_command not defined\n" if !$window_command; my $big_command=&process_tags($window_command, { %$entry_tags_ref, C=>$command, t=> $title } ); $command=$big_command; } my $use_pipe=$actions{$action}{use_pipe}; my $keep_open=$actions{$action}{keep_open}; if (! defined $use_pipe) { system("$command&"); return; } my $commandfd; # deal with an existing keep_open if we have keep_open set if (!defined $keep_open || !defined $real_mode_keep_open{action}) { # nothing to do } elsif ($real_mode_keep_open{action} ne $action) { # if we already have a different keep_open action, close it close $real_mode_keep_open{handle}; delete $real_mode_keep_open{action}; delete $real_mode_keep_open{handle}; } elsif ($real_mode_keep_open{action} eq $action) { $commandfd=$real_mode_keep_open{handle}; die "Internal error: no commandfd" unless $commandfd; } # if no commandfd yet (ie. no keep_open for this action) then start # one if (!$commandfd) { $commandfd=new FileHandle("|$command"); if (!$commandfd) { warn "$prog: Unable to run $command\n"; return; } if (defined $keep_open) { $real_mode_keep_open{action}=$action; $real_mode_keep_open{handle}=$commandfd; } } print $commandfd $message; $commandfd->flush; close $commandfd if !defined $keep_open; } sub throttle { my $timespec=shift; my $key=shift; my $seconds; my $now=time; if ($timespec =~ m{^(?:(?:(\d+)\:)?(\d+)\:)?(\d+)$}) { $seconds=(defined $1?$1:0) * 3600 + (defined $2?$2:0) * 60 + $3; } else { warn "$prog: timespec in 'throttle $key' is illegal\n"; return 0; } if (exists $throttle_state{$key} && $throttle_state{$key}+$seconds > $now) { return 1; } $throttle_state{$key}=$now; return 0; } sub read_paragraph { my $lines_arr_ref=shift || die "Internal error"; my $line_ref=shift || die "Internal error"; my @return; while (defined ($_=$$lines_arr_ref[++$$line_ref]) && !m{^\s*$}) { chomp; s{^\s+}{}; next if m{^\#}; push @return, $_; } return @return; } sub process_tags { my $string=shift; my $tags_ref=shift || die "Internal error: missing arg"; my $tag_char=shift; $tag_char='%' unless defined $tag_char; # a nice default my $pre_string=$string; $string =~ s{\\(.)}{ defined $backslash_tags{$1} ? $backslash_tags{$1} : die "undefined backslash tag in '$pre_string': \\$1\n"}eg; $string =~ s{\Q$tag_char\E(\-?\d*)([^\d\-])}{ defined $$tags_ref{$2} ? sprintf("%${1}s", $$tags_ref{$2}) : die "undefined tag in '$pre_string': \%$1$2\n"}eg; return $string; } # some (evil) globals to get around scope issues my ($global_file, $global_line, %config_state); sub config_parse { my $fh=shift || die "$prog: Internal error: undefined arg"; my $filename=shift || die "$prog: Internal error: undefined arg"; my $config_scalar=shift || die "$prog: Internal error: undefined arg"; my $config_array=shift || die "$prog: Internal error: undefined arg"; my $depth=shift; die "$prog: Internal error: undefined arg" unless defined $depth; $global_file=$filename; $global_line=0; &config_die("you've exceeded $include_depth_limit levels of includes") if $depth>=$include_depth_limit; my ($keyword, $vartype, $varname, @arrvalue, $varvalue); my $config_version=undef; my $file_version=undef; my @lines; # use a state table for the config my $state='toplevel'; &config_state_populate if !%config_state; # variables designed to deal with fancy pattern configs my ($logtype, $pattern, $format, $count, $dest, $eventref); my (%my_patterns); my $destref; # variables designed to deal with fancy category configs my ($category); # variables for fancy action config my ($action); while(<$fh>) { chomp; push @lines, $_; last if m{^\s*\@\@end\s*$}; } &config_preprocessor(\@lines, $filename); for (my $line=0; $line<@lines; $line++) { $_=$lines[$line]; # update for each line, or recursive include will play havoc $global_file=$filename; $global_line=$line; next if m{^\s*\#}; next if m{^\s*$}; s{^\s*}{}; my $is_local=0; my $nowarn=0; $is_local=1 if s{^local\s+}{}i; $nowarn=1 if s{^nowarn\s+}{}i; if (s{^(\S+)\s*}{}) { my $keyword=lc $1; &config_check_state($state, $keyword); if ($keyword =~ m{^(set|add|remove|prepend)$}) { $state='toplevel'; if (! s{^(\S+)\s*}{} || ($vartype=$1, $vartype!~m{^(arr|var)$})) { &config_die("$keyword should be followed by arr or var"); } if (! s{^\s*([^\s\=]+)\s*}{}) { &config_die("$vartype should be followed by name"); } $varname=$1; &config_die("'$varname' is not a legal variable name") if $varname !~ m{([A-Za-z]\w+)}; &config_die("keyword 'remove' not allowed with vartype 'var'") if $vartype eq 'var' && $keyword eq 'remove'; &config_die("can't find '=' in the right place") unless s{^\s*\=\s*}{}; if ($vartype eq 'var') { $varvalue=$_; if ($keyword eq 'set') { $config_scalar->{$varname}=$varvalue; $is_local{var}{$varname}=1 if $is_local; } elsif ($keyword eq 'add') { $config_scalar->{$varname}.=$varvalue; $is_local{var}{$varname}=1 if $is_local; } elsif ($keyword eq 'prepend') { $config_scalar->{$varname}=$varvalue. $config_scalar->{$varname}; $is_local{var}{$varname}=1 if $is_local; } else { &config_die("Internal error: unknown keyword ". "$keyword for vartype $vartype"); } &import_scalar($varname, $config_scalar->{$varname}) if exists $import_scalars{$varname}; } elsif ($vartype eq 'arr') { @arrvalue=&read_paragraph(\@lines, \$line); if ($keyword eq 'set') { $config_array->{$varname} = [ @arrvalue ]; $is_local{arr}{$varname}=1 if $is_local; } elsif ($keyword eq 'add') { push @{$config_array->{$varname}}, @arrvalue; $is_local{arr}{$varname}=1 if $is_local; } elsif ($keyword eq 'prepend') { unshift @{$config_array->{$varname}}, @arrvalue; $is_local{arr}{$varname}=1 if $is_local; } elsif ($keyword eq 'remove') { my @items_to_remove=&unique(@arrvalue); s{([^\w])}{\\$1}g foreach @items_to_remove; my $remove_pattern=join('|', @items_to_remove); $remove_pattern=qr{^(?:$remove_pattern)$}; my $size_before=@{$config_array->{$varname}}; @{$config_array->{$varname}}= grep(!m{$remove_pattern}, @{$config_array->{$varname}}); warn "wasn't able to remove all requested elements ". "from $varname" if $size_before-@{$config_array->{$varname}}< @items_to_remove; } else { die "Internal error: unknown keyword $keyword ". "for vartype $vartype"; } &import_array($varname, @{$config_array->{$varname}}) if exists $import_arrays{$varname}; } else { die "Internal error: unknown vartype $vartype"; } } elsif ($keyword eq 'logtype:') { $state='seen logtype'; $logtype=&config_arguments($_, $keyword, 1); } elsif ($keyword eq 'pattern:') { $state='seen pattern'; $pattern=&config_arguments($_, $keyword, 1); $format=$count=$dest=undef; push @{$my_patterns{$logtype}}, $pattern; $is_local{pattern}{$logtype}{$pattern}=1 if $is_local; } elsif ($keyword =~ m{^delete_if_unique:?$}) { $state='expecting dest'; &config_arguments($_, $keyword, 0, 0); $destref->{delete_if_unique}=""; } elsif ($keyword =~ m{^use_sprintf:?$}) { $state='expecting dest'; &config_arguments($_, $keyword, 0, 0); $destref->{use_sprintf}=""; } elsif ($keyword eq 'format:') { $state='expecting dest'; $format=&config_arguments($_, $keyword, 1); $destref->{format}=$format; } elsif ($keyword eq 'count:') { $state='expecting dest'; $count=&config_arguments($_, $keyword, 1); $destref->{count}=$count; } elsif ($keyword eq 'dest:') { $state='seen dest'; $dest=&config_arguments($_, $keyword, 1); # special destinations: SKIP, LAST, UNIQUE whatever &config_die("dest $dest may not contain backslash\n") if $dest =~ m{\\}; push @categories, $dest if $dest ne 'LAST' && $dest ne 'SKIP'; $categories[$#categories]=~s{^(UNIQUE|CATEGORY)\s+}{}; &config_die("don't have a format for dest: $dest") if !defined $format && $dest ne 'LAST' && $dest ne 'SKIP'; $destref->{dest}=$dest; push @{$dests{$logtype}{$pattern}}, $destref; undef $destref; } elsif ($keyword eq 'dest_delete:') { $dest=&config_arguments($_, $keyword, 1); my $found=0; for (my $i=0; $i<@{$dests{$logtype}{$pattern}}; $i++) { my $destref=$dests{$logtype}{$pattern}[$i]; if ($dest eq $destref->{dest}) { splice(@{$dests{$logtype}{$pattern}}, $i, 1); $found=1; last; } } &config_warn("can't remove dest $dest") if !$found && !$nowarn; } elsif ($keyword eq 'category:') { $state='seen category'; $category=&config_arguments($_, $keyword, 1); push @categories, $category; $is_local{category}{$category}=1 if $is_local; } elsif ($keyword =~ m{^(filter|sort|derive|color|description|do_action|priority):$}) { $keyword=$1; my $arg=&config_arguments($_, $keyword, 1); my %func=( filter => \&filter, sort => \&sort_keys, derive => \&derive, color => \&color, do_action => \&do_nothing, throttle => \&do_throttle, description => \&do_nothing, priority => \&priority, ); die "Internal error: no handler for $keyword" if !exists $func{$keyword}; eval { &{$func{$keyword}}($arg); }; &config_die("Unknown $keyword syntax in $arg: $@\n") if $@; if ($state eq "seen category") { &config_warn("category $category already has a $keyword ". "($categories{$category}{$keyword}) ". "but has been defined as new $keyword $arg") if exists $categories{$category}{$keyword} && $categories{$category}{$keyword} ne $arg && !$nowarn; $categories{$category}{$keyword}=$arg; } elsif ($state eq "seen event") { $eventref->{val}{$keyword}=$arg; } elsif ($state =~ m{^((seen|expecting) dest|seen pattern)$}) { $state="expecting dest"; $destref->{$keyword}=$arg; } else { die("internal error: state $state"); } } elsif ($keyword eq 'action:') { $state='seen action'; $action=&config_arguments($_, $keyword, 1); $is_local{action}{$action}=1 if $is_local; } elsif ($keyword =~ m{^(command|window|throttle):$}) { $keyword=$1; my $arg=&config_arguments($_, $keyword, 1); $actions{$action}{$keyword}=$arg; } elsif ($keyword =~ m{^(use_pipe|keep_open):?$}) { $keyword=$1; &config_arguments($_, $keyword, 0, 0); $actions{$action}{$keyword}=""; } elsif ($keyword eq 'event:') { $state='seen event'; &config_arguments($_, $keyword, 0, 0); $eventref={}; $eventref->{val}{is_local}=1 if $is_local; push @event_config, $eventref; } elsif ($keyword eq "match") { &config_die("no tag name specified, ie. one of: ". join(" ", keys %name2tag)) if !s{^(\S+)\s*\:\s*}{}; my $tag_name=$1; &config_die("unknown tag name '$tag_name'. Known are: ". join(" ", keys %name2tag)) if !exists $name2tag{$tag_name}; my $val=&config_arguments($_, $keyword, 1); &config_warn("tag name $tag_name already defined") if exists $eventref->{$tag_name} && !$nowarn; $eventref->{$name2tag{$tag_name}}=$val; } elsif ($keyword eq 'block_comment') { $state='toplevel'; &config_arguments($_, $keyword, 0, 0); &read_paragraph(\@lines, \$line); } elsif ($keyword eq 'include_if_exists' || $keyword eq 'include'){ $state='toplevel'; my $filename=&config_arguments($_, $keyword, 1, 1); &config_flush(\%my_patterns); # see comment before the sub &include_file($filename, $keyword eq 'include'?1:0, $depth); } elsif ($keyword eq 'include_dir_if_exists' || $keyword eq 'include_dir' ) { $state='toplevel'; my $dirname=&config_arguments($_, $keyword, 1, 1); &config_flush(\%my_patterns); # see comment before the sub &include_dir($dirname, $keyword eq 'include_dir'?1:0, $depth); } elsif ($keyword eq 'config_version') { $state='toplevel'; warn "already saw config_version before" if defined $config_version; $config_version=&config_arguments($_, $keyword, 1, 1); &config_die("config_version should be a version string") unless $config_version =~ m{^([\d+\.]+)$}; &config_die("config version '$config_version' is too old") if &funky_cmp($config_version, $minimum_version)<0; &config_die("config version '$config_version' is newer than I") if &funky_cmp($config_version, $current_version)>0; } elsif ($keyword eq 'file_version') { $state='toplevel'; warn "already saw file_version before" if defined $file_version; $file_version=&config_arguments($_, $keyword, 1); } elsif ($keyword eq 'end') { $state='toplevel'; &config_warn('"end" should be replaced with "@@end"') if !$nowarn; &config_arguments($_, $keyword, 0, 0); last; } else { &config_die("unknown keyword in config: $keyword"); } } } $global_line='EOF'; &config_check_state($state, "end"); &config_die("'config_version' should be set (ie. to $current_version)") if (! defined $config_version); push @config_versions, sprintf("%-50s %-8s %s\n", $filename, (defined $config_version? $config_version: ""), (defined $file_version? $file_version: "") ); &config_flush(\%my_patterns); # see comment before the sub } # The upcoming code is obscene. The reason it's necessary is # that most of the config has a natural tendency to be overridden # by later configs, while the pattern stuff has a natural # tendency to be overridden by earlier configs. I like # consistency, so I chose overriding with later configs. This # code implements that by prepending the local patterns to the # global pattern list. # THIS MUST BE CALLED BEFORE DOING ANY INCLUDES. sub config_flush { my $patterns_ref=shift; foreach my $logtype (keys %$patterns_ref) { unshift @{$patterns{$logtype}}, @{$$patterns_ref{$logtype}}; } undef %$patterns_ref; } # enforce that the config is in a state we allow sub config_check_state { my $state=shift; my $keyword=shift; $keyword=~s{\:$}{}; die "Internal error: no config_state for state $state" if !defined $config_state{$state}; my %allowed_state; @allowed_state{split(/\s+/, $config_state{$state})}=undef; &config_die("keyword $keyword when in state '$state' and expecting ". "one of: $config_state{$state}") if ! exists $allowed_state{$keyword}; } # this function sets up %config_state, the variable that describes allowed # config state transitions sub config_state_populate { %config_state=( "toplevel" => "set add remove prepend logtype action event ". "config_version file_version block_comment ". "include include_if_exists include_dir include_dir_if_exists ". "category end ", "seen logtype" => "pattern ", "expecting dest" => "dest use_sprintf delete_if_unique format count ", "seen action" => "command window throttle use_pipe keep_open ", "seen category" => "filter sort derive ", "seen event" => "match priority ", ); # The following commands are good in several states: foreach my $state ("expecting dest", "seen category", "seen event") { $config_state{$state}.="color description do_action priority "; } $config_state{"seen pattern"} = $config_state{"expecting dest"}; $config_state{"seen dest"} = $config_state{"expecting dest"}. $config_state{"seen logtype"}; # "dest_delete" can only be used after a dest or after a pattern $config_state{"seen pattern"} .= "dest_delete "; $config_state{"seen dest"} .= "dest_delete "; # the following states can transition back to toplevel: foreach my $state ("seen logtype", "seen dest", "seen action", "seen category", "seen event") { $config_state{$state}.=$config_state{toplevel}; } } sub config_arguments { my $string=shift; my $keyword=shift; my $min=shift; my $max=shift; die "Internal error: min>max" if defined $max && $min>$max; $string=~s{^\s+}{}; if (defined $max && $max==0) { &config_die("keyword '$keyword' takes no args") if $string=~m{\S}; } elsif ($min==1 && !defined $max) { &config_die("keyword '$keyword' needs an arg") if $string !~ m{\S}; return $string; } elsif (defined $max && $max==1) { my @split = split(/\s+/, $string); &config_die("keyword '$keyword' may have no more than one arg") if @split>1; return $string; } else { die "Internal error"; } } # this preprocessor should have identical features to the aide preprocessor sub config_preprocessor { my $config_ref=shift || die "Internal error"; my $filename=shift || die "Internal error"; my @if_else_stack; # did we last see an if or an else? my @active_stack=(1); # should we use lines we see, or are we in a false # if? I couldn't think of a better name for this. . . for (my $line=0; $line<@$config_ref; $line++) { # perform variable substitutions $config_ref->[$line]=~ s(\@\@\{(\w+)\})(exists $VAR{$1}? $VAR{$1}: "\@\@\{$1\}")eg; $_=$config_ref->[$line]; my $raw_line=$_; # process directives if present if (s{^\s*(\@\@\S+)\s*}{}) { my $directive=$1; $global_file=$filename; $global_line=$line; if (0) { } elsif ($directive =~ m{^\@\@define$}) { if (!m{^(\S+)\s+(\S+)$}) { &config_die("directive $directive takes two arguments"); } if ($active_stack[$#active_stack]) { $VAR{$1}=$2; } } elsif ($directive =~ m{^\@\@undef$}) { if (!m{^(\S+)\s*$}) { &config_die("directive $directive takes one argument"); } if ($active_stack[$#active_stack]) { delete $VAR{$1}; } } elsif ($directive =~ m{^\@\@ifn?def$}) { my $invert=($directive eq '@@ifdef'? 0 : 1); if (!m{^(\S+)\s*$}) { &config_die("directive $directive takes one argument"); } push @active_stack, ($active_stack[$#active_stack] && ($invert xor exists($VAR{$1}))); push @if_else_stack, "if"; } elsif ($directive =~ m{^\@\@ifn?host$}) { my $invert=($directive eq '@@ifhost'? 0 : 1); if (!m{^(\S+)\s*$}) { &config_die("directive $directive takes one argument"); } push @active_stack, ($active_stack[$#active_stack] && ($invert xor ($nodename eq $1))); push @if_else_stack, "if"; } elsif ($directive =~ m{^\@\@ifn?os$}) { my $invert=($directive eq '@@ifos'? 0 : 1); if (!m{^(\S+)\s*$}) { &config_die("directive $directive takes one argument"); } push @active_stack, ($active_stack[$#active_stack] && ($invert xor ($osname eq $1))); push @if_else_stack, "if"; } elsif ($directive =~ m{^\@\@else$}) { if (!m{^\s*$}) { &config_die("directive $directive takes no arguments"); } &config_die('@@else without @@if') if !@if_else_stack; &config_die('@@else when already in else') if $if_else_stack[$#if_else_stack] eq 'else'; $if_else_stack[$#if_else_stack]='else'; $active_stack[$#active_stack]=$active_stack[$#active_stack-1] && !$active_stack[$#active_stack]; } elsif ($directive eq '@@endif') { if (!m{^\s*$}) { &config_die("directive $directive takes no arguments"); } &config_die("endif without if") if !@if_else_stack; pop @active_stack; pop @if_else_stack; } elsif ($directive eq '@@end') { if (!m{^\s*$}) { &config_die("directive $directive takes no arguments"); } # don't need to do anything, handled by the config file reader } elsif ($directive eq '@@output') { if ($active_stack[$#active_stack]) { $raw_line.="\n" if $raw_line !~ m{\n$}; print $raw_line; } } elsif ($directive eq '@@warn') { if ($active_stack[$#active_stack]) { $raw_line.="\n" if $raw_line !~ m{\n$}; warn $raw_line; } } elsif ($directive eq '@@error') { if ($active_stack[$#active_stack]) { $raw_line.="\n" if $raw_line !~ m{\n$}; &config_die($raw_line); } } else { &config_die("no such preprocessor directive: $directive"); } # Null the line to avoid confusing the config processor $config_ref->[$line]='#'; } else { # not in a preprocessor directive if (!$active_stack[$#active_stack]) { # then we don't want the line $config_ref->[$line]='#'; } } } $global_line='EOF'; &config_die("unterminated if") if @if_else_stack; die "Internal error" if @active_stack != 1; } sub config_die { defined(my $error=shift) || die "Internal error"; my $line=$global_line; $line++ unless $line eq "EOF"; die "$prog: config $global_file line $line: error: $error\n"; } sub config_warn { my $error=shift || die "Internal error"; my $line=$global_line; $line++ unless $line eq "EOF"; warn "$prog: config $global_file line $line: $error\n"; } sub include_file { defined(my $filename=shift) || die "$prog: internal err: missing arg"; defined(my $must_exist=shift) || die "$prog: internal err: missing arg"; defined(my $depth=shift) || die "$prog: internal err: missing arg"; $filename=&process_tags($filename, \%tags); if (! -r $filename) { &config_die("included filename $filename is not readable\n") if $must_exist; } else { my $configfh=new FileHandle("<$filename") || die "$prog: open $filename: $!\n"; config_parse($configfh, $filename, $config_scalar, $config_array, $depth+1); } } sub include_dir { defined(my $dirname=shift) || die "$prog: internal err: missing arg"; defined(my $must_exist=shift) || die "$prog: internal err: missing arg"; defined(my $depth=shift) || die "$prog: internal err: missing arg"; if (!-r $dirname || !-x $dirname) { &config_die("included dir $dirname is not readable") if $must_exist; return; } local *DIR; opendir (DIR, $dirname) || &config_die("$prog: opendir $dirname: $!"); ! -d $_ && !&should_ignore_file($_) && &include_file($_, 1, $depth) foreach (map {"$dirname/$_"} readdir DIR); closedir DIR; } sub make_pattern { return "^(?:".join("|", @_).")" if @_; return "^\777"; } sub string_nocase_sort_helper { return lc $a cmp lc $b; } sub string_sort_helper { return $a cmp $b; } sub numeric_sort_helper { return $a <=> $b; } sub funky_sort_helper { my $a1=$a; my $b1=$b; $a1=~s{\s+(\d)}{ $1}g; $b1=~s{\s+(\d)}{ $1}g; while (length $a1 && length $b1) { if ($a1=~m{^(\d+)} && (my $a2=$1, $b1=~m{^(\d+)})) { my $ret = $a2<=>$1; return $ret if $ret; $a1=~s{^\d+}{}; $b1=~s{^\d+}{}; } elsif ($a1=~m{^([^\d]+)} && (my $a3=$1, $b1=~m{^([^\d]+)})) { my $ret = $a3 cmp $1; return $ret if $ret; $a1=~s{^[^\d]+}{}; $b1=~s{^[^\d]+}{}; } else { return $a1 cmp $b1; } } return $a1 cmp $b1; } # this sort function takes a hash ref and returns the keys sorted by their # value in the hash. Yes, this is weird. sub sort_by_value { my $hash_ref=shift; my @arr=@_; return sort {$hash_ref->{$a} <=> $hash_ref->{$b}} @arr; } # see comment for sort_by_value. sub reverse_sort_by_value { my $hash_ref=shift; my @arr=@_; return sort {$hash_ref->{$b} <=> $hash_ref->{$a}} @arr; } # funky_cmp sets up a call to funky_sort_helper. Usually you'd expect things # to be the other way around, but funky_sort_helper is more performance # critical, so I dropped some function overhead. sub funky_cmp { local($a, $b)=(shift, shift); return &funky_sort_helper; } sub import_scalar { defined(my $name=shift) || die "Internal error"; defined(my $value=shift) || die "Internal error"; eval "\$$name".'=$value;'; die "$@" if $@; $in_config{$name}=1; # these variables should take immediate effect $ENV{PATH}=$PATH; $tags{n}=$nodename; $tags{s}=$osname; $tags{r}=$osrelease; umask oct $umask; } sub import_array { defined(my $name=shift) || die "Internal error"; my @values=@_; if (exists $arrays_to_become_hashes{$name}) { my %hash; foreach my $entry (@values) { die "name has an entry that isn't in key, value format:\n$entry\n" if $entry !~ m{^([^,]+),\s+(.*)$}; $hash{$1}=$2; } eval "\%$name".'=%hash'; die "$@" if $@; } else { eval "\@$name".'=@values'; die "$@" if $@; } $in_config{$name}=1; } sub import_config_vars { my $config_scalar=shift || die "$prog: Internal error: expecting arg"; #mta my $config_array=shift || die "$prog: Internal error: expecting arg"; my $PATH; my ($i); my (%big_eval, %filename_pats); # verify that all required arrays are defined foreach (@required_import_arrays) { die "config missing required array '$_'\n" unless exists $config_array->{$_}; } # verify that all required scalars are defined foreach (@required_import_scalars) { die "config missing scalar $_\n" unless exists $config_scalar->{$_}; } # standard arrays should already be imported, so remove them from # the namespace foreach (@required_import_arrays, @optional_import_arrays, @arrays_to_become_hashes) { next unless exists $config_array->{$_}; delete $config_array->{$_}; } # standard scalars should already be imported, so remove them from # the namespace foreach (@required_import_scalars, @optional_import_scalars) { next unless exists $config_scalar->{$_}; delete $config_scalar->{$_}; } # make sure certain arrays contain only unique elements @log_type_list = &unique(@log_type_list); @optional_log_files = &unique(@optional_log_files); foreach my $log_type (@log_type_list) { foreach my $ext (@per_log_required_scalar_exts) { my $i="${log_type}_$ext"; die "config missing scalar $i required by logtype $log_type\n" unless exists $config_scalar->{$i}; } foreach my $ext (@per_log_required_scalar_exts, @per_log_optional_scalar_exts) { my $i="${log_type}_$ext"; next unless exists $config_scalar->{$i}; $log_scalar{$log_type}{$ext}=$config_scalar->{$i}; delete $config_scalar->{$i}; } foreach my $ext (@per_log_required_array_exts) { my $i="${log_type}_$ext"; die "config missing array $i required by logtype $log_type\n" unless exists $config_array->{$i}; } foreach my $ext (@per_log_required_array_exts, @per_log_optional_array_exts) { my $i="${log_type}_$ext"; next unless $config_array->{$i}; $log_array{$log_type}{$ext}=$config_array->{$i}; delete $config_array->{$i}; } } foreach my $key (%$config_array) { die "unknown array defined in config: $key\n"; } foreach my $key (%$config_scalar) { die "unknown scalar defined in config: $key\n"; } foreach my $var (@legacy_pats) { eval "\$${var}_pat=\$pat{$var} if ! defined ". "\$${var}_pat and exists \$pat{$var}; "; die "$@" if $@; } #special rule for $PATH $ENV{PATH}=$PATH if $PATH; # # special stuff for permission checking # # if either "rw" array exists, only users in it are allowed if (@gui_mode_configure_allow_users || @gui_mode_configure_allow_groups) { $gui_mode_configure_disabled=1 if !&set_is_member($user, \@gui_mode_configure_allow_users) && !&set_intersection(\@groups, \@gui_mode_configure_allow_groups); } $gui_mode_configure_disabled=1 if &set_is_member($user, \@gui_mode_configure_deny_users) || &set_intersection(\@groups, \@gui_mode_configure_deny_groups); } sub run_evals { for my $type (@log_type_list) { my $eval = $evals->{$type}; eval $eval; die "$prog: error in eval for type $type (use -I evals to list): $@\n" if $@; } } sub build_log_stuff { my ($i, %big_eval, %filename_pats); # brass tacks time foreach my $type (@log_type_list) { for (my $relday=$relday_start; $relday >= $relday_end; $relday--) { $when{$type}{lc strftime($log_scalar{$type}{date_format}, &relday2time($relday))}=$relday; } # backwards compatibility for skip_list if (exists $log_array{$type}{skip_list}) { my $skip_pattern=&make_pattern( map( m{\$$} ? $_ : "$_.*", @{$log_array{$type}{skip_list}})); push @{$patterns{$type}}, $skip_pattern; push @{$dests{$type}{$skip_pattern}}, {dest=>"SKIP"}; delete $log_array{$type}{skip_list}; } # backwards compatibility for raw_rules foreach my $raw_rule (@{$log_array{$type}{raw_rules}}) { my ($category, $pattern, $format, $code_hook) =split(m{, }, $raw_rule); eval "'foo' =~ m{$pattern}"; # check pattern for validity die "problem with pattern '$pattern':\n\t$@\n" if $@; die "1st field missing in rule '$raw_rule'" if ! defined $category; die "2nd field missing in rule '$raw_rule'" if ! defined $pattern; die "3rd field missing in rule '$raw_rule'" if ! defined $format; die "4th field removed in version 0.35, sorry" if defined $code_hook; $pattern.=".*" unless $pattern=~m{\$$}; my $destref={ dest=>$category, format=>$format }; push @{$patterns{$type}}, $pattern; push @{$dests{$type}{$pattern}}, $destref; push @categories, $category; delete $log_array{$type}{raw_rules}; } my $unknowns="Unknowns for type $type"; push @unknown_categories, $unknowns; push @categories, $unknowns; push @categories, $other_host_message; # now let's build the big eval my $big_eval="\$do_type{$type} = sub {\n"; $big_eval.="\tdefined(my \$file=shift) || die qq($prog: missing arg);\n"; $big_eval.="\tdefined(my \$fh=shift) || die qq($prog: missing arg);\n"; $big_eval.="\n"; $big_eval.="\tmy \$relday;\n"; if (!$real_mode) { # only for real-mode do we need to maintain global per-file last # and multiplier state, so when not in real mode, let's have # local variables to make this a bit faster $big_eval.="\tmy (\%last, \%multiplier);\n"; $big_eval.="\t\$multiplier{\$file}=1;\n"; } $big_eval.="\tmy \$host=\$nodename;\n"; $big_eval.="\tmy \$raw_line;\n"; $big_eval.="\tmy \$pos=tell \$fh;\n" if $real_mode; $big_eval.="\twhile(<\$fh>) {\n"; $big_eval.="\t\tnext if ! defined;\n"; $big_eval.="\t\t\$raw_line=\$_;\n"; $big_eval.="\t\tmy \$entry_tags_ref;\n"; $big_eval.="\t\tmy \%deletes_for_unique;\n"; $big_eval.="\t\tif (!m{\\n\$}) {\n"; $big_eval.="\t\t\t\$incomplete{\$file}.=\$_; last; \n"; $big_eval.="\t\t} elsif (length \$incomplete{\$file}) {\n"; $big_eval.="\t\t\t\$_=\$incomplete{\$file}.\$_;\n"; $big_eval.="\t\t\t\$incomplete{\$file}='';\n\t\t}\n\n"; $big_eval.="\t\tchomp;\n"; $big_eval.=join("", map("\t\t$_\n", @{$log_array{$type}{pre_date_hook}})) if $log_array{$type}{pre_date_hook}; $big_eval.="\n"; $big_eval.="\t\t# deal with the date (if applicable)\n"; $big_eval.="\t\tif(s{$log_scalar{$type}{date_pattern}}{}) {\n"; if (!$show_all && !$real_mode) { # ie. simple report mode $big_eval.="\t\t\t\$relday=\$when{\$type}{lc \$1};\n"; $big_eval.="\t\t\tif (!defined \$relday) {\n"; $big_eval.="\t\t\t\tnext; \n"."\t\t\t}\n"; } elsif ($show_all && $is_multiday) { $big_eval.="\t\t\tif (!defined \$when{\$type}{lc \$1}) {\n"; $big_eval.="\t\t\t\tnext; \n"."\t\t\t}\n"; $big_eval.="\t\t\t\$relday=\$relday_end;\n"; } elsif ($show_all) { $big_eval.="\t\t\t\$relday=\$relday_end;\n"; } elsif ($real_mode) { $big_eval.="\t\t\tif (!defined \$when{\$type}{lc \$1} && "; $big_eval.="\$real_mode_before_now) {\n"; $big_eval.="\t\t\t\tnext; \n"."\t\t\t}\n"; $big_eval.="\t\t\t\$relday=\$relday_end;\n"; } else { die "$prog: internal error: we should never reach this"; } $big_eval.="\t\t} else {\n"; $big_eval.="\t\t\twarn qq(can't find $type date_pattern in '\$_');\n"; $big_eval.="\t\t\tnext;\n"; $big_eval.="\t\t}\n\n"; $big_eval.="\t\t# deal with the hostname (if applicable)\n"; if ($log_scalar{$type}{nodename_pattern}) { $big_eval.="\t\tif(s{$log_scalar{$type}{nodename_pattern}}{}) {\n"; $big_eval.="\t\t\t\$host=\$1;\n"; if (defined $domain && !$leave_FQDNs_alone) { $big_eval.="\t\t\t\$host=~s{\.(${domain}|localdomain)\$}{};\n"; } if ($process_all_nodenames) { } elsif (@allow_nodenames) { $big_eval.="\t\t\tif (! exists \$nodename_allowed{\$host}) {\n"; $big_eval.=&build_out_string("\t\t\t\t", '$relday', '$nodename', '$other_host_message', '$host', '$multiplier{$file}', '$raw_line', '$_',0,quotemeta($type)); $big_eval.= "\t\t\t\tnext;\n\t\t\t}\n"; } else { $big_eval.="\t\t\tif (\$host ne '$nodename') { \n"; $big_eval.=&build_out_string("\t\t\t\t", '$relday', '$nodename', '$other_host_message', '$host', '$multiplier{$file}', '$raw_line', '$_',0,quotemeta($type)); $big_eval.="\t\t\t\tnext;\n\t\t\t}\n"; } $big_eval.="\t\t} else {\n"; $big_eval.="\t\t\tdie qq(Can't find $type nodename_pattern in '\$_');\n"; $big_eval.="\t\t}\n"; } if ($log_array{$type}{pre_skip_list_hook}) { $big_eval.=join("", map("\t\t$_\n", @{$log_array{$type}{pre_skip_list_hook}})); } $big_eval.="\t\t# if (0) up front, so we can use elsif everywhere\n"; $big_eval.="\t\tif (0) {\n"; $big_eval.="\t\t} "; &patterns_deduplicate; $i=0; foreach my $pattern (@{$patterns{$type}}) { my $destsref=$dests{$type}{$pattern}; $big_eval.=&build_pattern_string($type, $pattern, $destsref); } $big_eval .= qq( else {\n); $big_eval.=&build_out_string("\t\t\t", '$relday', '$host', qq("$unknowns"), '$_', '$multiplier{$file}', '$raw_line', '$_',1, quotemeta($type)); if ($unknowns_only) { $big_eval .= qq(\t\tprint "\$_\\n" if !\$unknowns{$type}{\$_}++;\n); $big_eval .= qq(\t\t\$unknowns_raw{$type}{\$raw_line}++;\n); } $big_eval .= qq(\t\t\tnext; \n). qq(\t\t}\n).qq(\t} continue {\n); $big_eval .= qq(\t\t\$last{\$file}=\$raw_line;\n); $big_eval .= qq(\t\t\$multiplier{\$file}=1;\n); $big_eval .= qq(\t\t\$pos=tell \$fh;\n) if $real_mode; if ($gui_mode) { $big_eval .= qq(\t\t\&gui_mode_status_scanning;\n); $big_eval .= qq(\t\tif (\$gui_mode_types_redone) {\n); $big_eval .= qq(\t\t\t\$gui_mode_types_redone=0;\n); $big_eval .= qq(\t\t\tlast;\n); $big_eval .= qq(\t\t}\n); } $big_eval .= qq(\t}\n); $big_eval .= qq(}\n); $big_eval{$type}=$big_eval; $filename_pats{$type}=&make_pattern(@{$log_array{$type}{filenames}}); } @nodename_allowed{@allow_nodenames}=1 x @allow_nodenames; $nodename_allowed{$nodename}=1; @categories=&unique(@categories); return \%big_eval, \%filename_pats; } # build the pattern string. Can either be called from build_log_stuff as one # of many patterns, in which case set is_standalone=0, or can be called # for dest testing, in which case set is_standalone=1 sub build_pattern_string { my ($type, $pattern, $destsref, $is_standalone, $is_test)=@_; my $ret=""; my $pattern_normal=$pattern; $pattern_normal.='\s*$' unless $pattern=~m{\$$}; $pattern_normal="^$pattern_normal" unless $pattern=~m{^\^}; if ($is_standalone) { $ret.="{\n"; $ret.="\tmy \$file='__INTERNAL';\n"; $ret.="\tmy \$relday=\$relday_end;\n"; $ret.="\tmy \$entry_tags_ref;\n"; $ret.="\tmy \%deletes_for_unique;\n"; $ret.="\tlocal \$SIG{__WARN__}=sub { die \@_ };\n"; # upgrade warnings $ret.="\t\tif (0) {\n"; $ret.="\t\t}"; } $ret.=" elsif (m{$pattern_normal}o) {\n"; $ret.="\t\t\tmy \%unique;\n" if $is_test; my $num_dests=0; $num_dests=@$destsref if defined $destsref; warn "$prog: no dests for pattern $pattern\n" if !$num_dests; my $which_dest=0; foreach my $destref (@$destsref) { my $format=$destref->{format}; my $dest=$destref->{dest}; my $count=1; my $delete_if_unique=undef; $count=$destref->{count} if exists $destref->{count}; if ($dest eq 'LAST') { # special dest die "LAST dest can only be used as the only dest" unless $num_dests == 1; $ret.=qq(\t\t\t\$multiplier{\$file}=$count;\n); $ret.=qq(\t\t\t\$_=\$last{\$file};\n); $ret.=qq(\t\t\tundef \$last{\$file};\n); $ret.=qq(\t\t\tredo if defined \$_;\n); $ret.=qq(\t\t\tnext;\n); } elsif ($dest eq 'SKIP') { # another special dest die "SKIP dest can only be used as the only dest for ". "pattern $pattern logtype $type" unless $num_dests == 1; $ret.=qq(\t\t\tundef \$last{\$file};\n); } elsif ($dest =~ m{^UNIQUE\s+(\S.*)}) { my $cat=$1; my ($part1, $part2); if ($format=~m{^(.+)\,([^,]+)$}) { $part1=$1; $part2=$2; } else { die "format $format needs 2 comma delimited values ". "UNIQUE dests\n"; } $ret.=qq(\t\t\t\$unique{\$relday}{\$host}{"$cat"}{$part1}{$part2}={}\n). qq(\t\t\t\tif !defined \$unique{\$relday}{\$host}{"$cat"}{$part1}{$part2};\n); $ret.=qq(\t\t\tforeach my \$l1 (keys \%deletes_for_unique) {\n); $ret.=qq(\t\t\t\tforeach my \$l2 (keys \%{\$deletes_for_unique{\$l1}}) {\n); $ret.=qq(\t\t\t\t\t\$unique{\$relday}{\$host}{"$cat"}). qq({$part1}{$part2}{\$l1}{\$l2}=undef;\n); $ret.=qq(\t\t\t\t}\n); $ret.=qq(\t\t\t}\n); } else { # normal dest $dest=~s{^CATEGORY\s+}{}; if (exists $destref->{use_sprintf}) { $format="sprintf($format)"; } else { $format="\"$format\""; } if (exists $destref->{delete_if_unique}) { $delete_if_unique=1; } $ret.=&build_out_string("\t\t\t", '$relday', '$host', qq("$dest"), $format, "$count*\$multiplier{\$file}", '$raw_line', '$_', 0, quotemeta($type), quotemeta($pattern), $which_dest, $delete_if_unique, $is_test); } $which_dest++; } $ret.=qq(\t\t\tnext;\n\t\t}); $ret.="\n}\n" if $is_standalone; return $ret; } sub build_out_string { my ($tab, $relday, $host, $category, $data, $count, $raw_line, $line, $is_unknown, $type, $pattern, $which_dest, $delete_if_unique, $is_test)=@_; my $ret=""; $ret.=$tab."\$entry_tags_ref={\%tags, '%'=>'%', h=>$host, _t=>'$type', \n". $tab."\tc=>$category, d=>$data, '#'=>$count, R=>$raw_line, A=>'', \n". $tab."\t_l=>$line, _u=>$is_unknown"; $ret.=qq(, _p=>"$pattern", _w=>$which_dest) if defined $pattern; $ret.="};\n"; $ret.=$tab."chomp \$entry_tags_ref->{R};\n"; if ($real_mode) { $ret.= $tab."\&real_mode_out($relday, \$entry_tags_ref)\n". $tab."\tunless \&is_ignored(\$entry_tags_ref);\n" if !$is_test; } else { $ret.= $tab."\tunless (\&is_ignored(\$entry_tags_ref)) {\n"; $ret.= $tab."\t\$count{$relday}{$host}{$category}{$data}+=$count;\n" if !$is_test; $ret.= $tab."\t\$deletes_for_unique{$category}{$data}=undef;\n" if $delete_if_unique && !$is_test; $ret.= $tab."}\n"; } return $ret; } sub build_event_tree { undef %event_tree; $event_change=time; foreach my $eventref (@event_config) { my $posref=\%event_tree; next if ! exists $eventref->{val}; foreach my $key (sort keys %{$eventref}) { next if $key eq 'val'; my $val=$eventref->{$key}; $posref->{$key}{$val}={} if !exists $posref->{$key} or !exists $posref->{$key}{$val}; $posref=$posref->{$key}{$val}; } $posref->{val}=$eventref->{val}; } } sub patterns_deduplicate { my %oldpatterns=%patterns; undef %patterns; my %pattern_seen; foreach my $type (keys %oldpatterns) { foreach my $pattern (@{$oldpatterns{$type}}) { if (!$pattern_seen{$type}{$pattern}++) { push @{$patterns{$type}}, $pattern; } } } my %olddests=%dests; undef %dests; # this algorithm looks horribly inefficient, but in practice, the number # of dests per pattern is likely to be 1 or a very small number foreach my $type (keys %olddests) { foreach my $pattern (keys %{$olddests{$type}}) { OLDDESTREF: foreach my $olddestref (@{$olddests{$type}{$pattern}}) { foreach my $destref (@{$dests{$type}{$pattern}}) { next OLDDESTREF if &hash_cmp($olddestref, $destref)==0; } push @{$dests{$type}{$pattern}}, $olddestref; } } } } sub hash_cmp { my $hash_ref_1=shift; my $hash_ref_2=shift; foreach my $key (keys %$hash_ref_1) { return 1 if ! exists $hash_ref_2->{$key}; my $ret=$hash_ref_1->{$key} cmp $hash_ref_2->{$key}; return $ret if $ret; } foreach my $key (keys %$hash_ref_2) { return -1 if ! exists $hash_ref_1->{$key}; } return 0; } # convert a date into the number of days before today sub normalize2relday { my $date=shift; die "$prog: normalize2relday: need at least one arg" unless defined $date; if ($date eq "today") { return 0; } if ($date eq "yesterday") { return 1; } if ($date =~ m{^\d+$}) { return $date; } if ($date =~ m{^(\d{4,})_(\d{1,2})_(\d{1,2})$}) { my $abs_day=&absdate2absday($1, $2, $3); my $abs_today=&absdate2absday(split(/\s+/, strftime("%Y %m %d", localtime($time_start)))); my $check=strftime("%Y_%m_%d", relday2time($abs_today-$abs_day)); die "$prog: BUG: normalize2relday check returned $check for $date\n" unless $check eq $date; return $abs_today-$abs_day; } die "Unknown date format: $date\n"; } # convert a relative date (ie. the number of days before today) into # a localtime sub relday2time { my $days_ago=shift; die "$prog: relday2time: need at least one arg" unless defined $days_ago; # move away from the edges of the day to avoid a problem involving # time zones. Yes, this is ugly. my $time_start_normalized=$time_start; my $hour=strftime("%H", localtime $time_start_normalized); $time_start_normalized-=7200 if $hour >20; $time_start_normalized+=7200 if $hour <4; return localtime($time_start_normalized-$days_ago*86400); } # convert an absolute year, month, day into days since Gregorian 0 sub absdate2absday { defined(my $year=shift) || die; defined(my $month=shift) || die; defined(my $day=shift) || die; my @month_acc=(0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334, 365); return ($year-1)*365+ int(($year-1)/4 )*(+1)+ int(($year-1)/100)*(-1)+ int(($year-1)/400)*(+1)+ $month_acc[$month-1]+ $day+ ($month>2 && (!($year%400) || (!($year%4) && ($year%100)))? 1 : 0); } sub filter { my $filter=shift; my %values=@_; if (0) { } elsif ($filter =~ m{^\s*(\S.*?) (and|or) (\S.*)\s*$}) { my $keyword = $2; my $filter1 = $1; my $filter2 = $3; my @return1 = &filter($filter1, %values); my @return2 = &filter($filter2, %values); if ($keyword eq "and") { my %in_return2; @in_return2{@return2}=undef; return grep {exists $in_return2{$_}} @return1; } elsif ($keyword eq "or") { return &unique(@return1, @return2); } else { die "Internal error"; } } elsif ($filter =~ m{^(>=|<=|<|>|=|==|!=|<>|><)\s+(\d+)\s*$}) { my $keyword=$1; my $value=$2; my $is_percent=$3; if (0) { # I like ifs to line up. . . } elsif ($keyword eq '>=') { return grep {$values{$_}>=$value} keys %values; } elsif ($keyword eq '<=') { return grep {$values{$_}<=$value} keys %values; } elsif ($keyword eq '<') { return grep {$values{$_}< $value} keys %values; } elsif ($keyword eq '>') { return grep {$values{$_}> $value} keys %values; } elsif ($keyword =~ m{^(=|==)$}) { return grep {$values{$_}==$value} keys %values; } elsif ($keyword =~ m{^(!=|<>|><)$}) { return grep {$values{$_}!=$value} keys %values; } } elsif ($filter =~ m{^((?:top|bottom)(?:_strict)?)\s+(\d+)(\%?)\s*$}) { my $keyword=$1; my $value=$2; my $is_percent=$3; if (0) { } elsif ($keyword =~ m{^(top|bottom)(_strict)?$}) { return if $value == 0; my $how_many=$value; my @keys=&sort_by_value(\%values, keys %values); @keys=reverse @keys if $1 eq "top"; my $is_strict=$2; if ($is_percent) { # switch to percentage die "percentage must be between 0 and 100" if $value<0 || $value>100; $how_many=&ceiling(@keys*$value/100); } return @keys if @keys <= $how_many; # no need to do more work my @return=splice(@keys, 0, $how_many); # what if we we have a bunch of items with equal value and the # top-whatever cuts off in the middle? Unless we strictly want # just the top-whatever, we should include those, too. my $last_val=$values{$return[$#return]}; while (!$is_strict && @keys && $values{$keys[0]}==$last_val) { push @return, shift @keys; } return @return; # done! } } elsif ($filter =~ m{^\s*none\s*$}) { return keys %values; } else { die "unknown filter format in $filter\n"; } return 1; } sub sort_keys { my $sort=lc shift; my $hash_ref=shift; my @keys=@_; $sort=~s{\s+}{ }g; die "No sort specified" if $sort =~ m{^\s*$}; my @sorts=reverse split(/\s/, $sort); foreach my $sort (@sorts) { if ($sort eq 'reverse') { @keys=reverse @keys; } elsif ($sort =~ m{^(funky|numeric|string)$}) { my $sort_helper="${sort}_sort_helper"; @keys=sort $sort_helper @keys; } elsif ($sort =~ m{^value$}) { @keys=&sort_by_value($hash_ref, @keys); } elsif ($sort eq "none") { } else { die "unknown sort: $sort\n"; } } return @keys; } sub derive { defined(my $derivation=lc shift) || die "Internal error"; my $relday=shift; my $host=shift; my ($keyword, $cat1, $cat2, $arg); my $quote_pat='\"([^\"]+)\"'; if ($derivation =~ m{^\s*$quote_pat\s+(add|subtract|remove)\s+$quote_pat\s*$}) { $keyword=$2; $cat1=$1; $cat2=$3; } elsif ($derivation =~ m{^\s*(=)\s+$quote_pat\s*$}) { $keyword=$1; $cat1=$2; } else { die "Derivation $derivation in illegal format\n"; } my %return=%{$count{$relday}{$host}{$cat1}} if defined $cat1 && defined $relday && defined $host && exists $count{$relday}{$host}{$cat1}; my %category2=%{$count{$relday}{$host}{$cat2}} if defined $cat2 && defined $relday && defined $host && exists $count{$relday}{$host}{$cat2}; if (0) { } elsif ($keyword eq "add") { foreach my $key (keys %category2) { $return{$key}+=$category2{$key}; } } elsif ($keyword eq "subtract") { foreach my $key (keys %category2) { $return{$key}-=$category2{$key}; } } elsif ($keyword eq "remove") { foreach my $key (keys %category2) { delete $return{$key}; } } else { die "Unknown keyword: $keyword\n"; } return %return; } sub priority { my $priority=shift; die "$prog: unknown value for priority: $priority\n" unless exists $priority_name{uc $priority}; } sub color { my $color=shift; my $do_color=shift; return if !defined $color; $color=lc $color; my @colors=split(/\s+/, $color); foreach my $i (@colors) { if (!exists $colors{$i}) { die "No such color: $i\n"; } else { next unless $do_color; print &process_tags($colors{$i}, {e=>"\033", a=>"\007"}); } } } sub ceiling { my $val=shift; return $val if int $val == $val; return int ($val + 1); } sub should_ignore_file { my $filename=basename shift; return 0 if !@filename_ignore_patterns; my $pattern=&make_pattern(@filename_ignore_patterns); return 1 if ($filename =~ m{${pattern}$}); return 0; } # mostly, you want perl to whine if it encounters undef when you ask it to # work with a value. But sometimes you don't. empty is like !length, except # without an error for undef. sub empty($) { my $val=shift; return 1 if !defined $val || !length $val; return 0; } # like above, sometimes perl's insistence on whining about undefined values # is undesirable. val_or_empty transparently converts an undef to an empty # string sub val_or_empty($) { my $val=shift; return "" if !defined $val; return $val; } sub do_nothing { } sub daemon_mode_syslog_on { setlogsock "unix"; openlog($prog, 'pid', 'daemon'); $SIG{__WARN__}=sub { my $m="@_"; $m=~s{^$prog: }{}; syslog("warning", "%s", $m); warn @_}; $SIG{__DIE__}=sub { my $m="@_"; $m=~s{^$prog: }{}; syslog("err", "%s", $m); die @_}; } # used by daemon mode to daemonize. Some blocks of the below code are # paraphrased from Proc::Daemon, as noted below. sub daemon_mode_daemonize { &daemon_mode_syslog_on; # in case it wasn't called already my $pid=$$; if (-f $daemon_mode_pid_file) { my $pidfd=new FileHandle ("< $daemon_mode_pid_file") or die "$prog: open $daemon_mode_pid_file: $!\n"; $pid=<$pidfd>; chomp $pid; die "$prog: already running in daemon mode\n" if $$ ne $pid && qx(ps -p $pid) =~ m{$prog}; } if (!$daemon_mode_foreground) { $pid=fork; # like Proc::Daemon die "$prog: fork: $!\n" if $pid<0; exit if $pid>0; } POSIX::setsid || die "$prog: setsid: $!\n"; # like Proc::Daemon if (!$daemon_mode_foreground) { $pid=fork; # like Proc::Daemon die "$prog: fork: $!\n" if $pid<0; exit if $pid>0; } # after we chdir /, a relative PID file won't work. Better make it # absolute. my $pid_file=$daemon_mode_pid_file; $pid_file = $cwd."/".$pid_file if $pid_file !~ m{^/}; my $pidfd=new FileHandle ("> $pid_file") || die "$prog: open $pid_file: $!\n"; print $pidfd "$$\n"; $pidfd->close; &rm_on_exit($pid_file); $SIG{HUP}='IGNORE'; # like Proc::Daemon $SIG{INT} = $SIG{TERM} = $SIG{QUIT} = $SIG{ABRT} = sub { my ($sig)=@_; die "$prog: exiting on signal $sig\n"; }; chdir "/" || die "$prog: chdir /: $!\n"; # like Proc::Daemon umask 077; # like Proc::Daemon STDIN->close; # like Proc::Daemon STDIN->open("+>/dev/null") || die "$prog: open /dev/null: $!\n"; STDOUT->close; # like Proc::Daemon STDOUT->open("+>&STDIN") || die "$prog: dup stdin: $!\n"; STDERR->close; # like Proc::Daemon STDERR->open("+>&STDIN") || die "$prog: dup stdin: $!\n"; warn "$prog: starting up\n"; } # handling for temporary files. It's a kinda magic. my @rm_on_exit; sub rm_on_exit { push @rm_on_exit, @_; } END { # this installs an atexit handler foreach my $file (@rm_on_exit) { unlink $file || warn "$prog: unable to unlink $file: $!\n"; } } __END__ # internal config file for log_analysis # what version config are we compatible with? Every config file should have # one of these. config_version @VERSION@ # what version is this file? If you like doing configuration management, set # this. file_version $Revision: 1.288 $ # sulog type # add our name to the log_type_list add arr log_type_list= sulog # set the basename(s) of the file(s) we'll be looking at. For sulog, that's # just "sulog", but for others, there are more than one (ie. syslog has # syslog, maillog, authlog, etc.) This is mandatory. set arr sulog_filenames= sulog # Some files (ie. wtmp, wtmpx) are in a binary format, so they need a # command to be run as an interpreter to be analyzed. This is optional. # It doesn't apply to the sulog format; see wtmp (later) for an example. #set var sulog_open_command= # If open_command and decompression_rules apply to the same file, then # two commands need to be run. How do we get output from one to the other? # A pipe won't always work, so we default to using temp files. This variable # lets you use a pipe instead. This is optional. It is ignored unless # open_command is set. None of the default log types use this, but I know # someone who wants it for his private ruleset. #set var sulog_pipe_decompress_to_open= # Arbitrary perl code to be run for each line, before doing anything else. # This is optional. sulog doesn't need it; see wtmp (later) for an # example. #set var sulog_pre_date_hook= # pattern that describes the date in each log line. The pattern will be # stripped off before proceeding. $1 should contain the date after the # pattern is run. This is mandatory. set var sulog_date_pattern=^SU\s+(\d+\/\d+)\s+\S+\s+ # date_format follow the rules for strftime(3). It should describe # the date as extracted to $1 in the last step. set var sulog_date_format=%m/%d # pattern that describes the nodename in each log line, after the date has # been stripped. It will be stripped off before proceeding. $1 should # contain the nodename. This is optional, and doesn't apply to sulog; # see syslog for an example. #set var sulog_nodename_pattern= # some lines of arbitrary perl code that get called after the nodename # has been stripped, before any further processing is done. sulog doesn't # use this; see syslog for a real example of this. This is optional. #set arr sulog_pre_skip_list_hook= # raw_rules and skip_list have been obsoleted by the new config format, so # they are deprecated, and can be ignored # set arr sulog_skip_list= # set arr sulog_raw_rules= @@ifndef __USE_MINIMAL_CONFIG logtype: sulog pattern: \-\s+\S+\s+($pat{user})\-($pat{user}) format: $1 => $2 dest: su: failed for pattern: \+\s+\S+\s+($pat{user})\-($pat{user}) format: $1 => $2 dest: su: succeeded for @@endif # and that's it for sulog. # wtmp type add arr log_type_list= wtmp # file basenames that this log type applies to set arr wtmp_filenames= wtmp wtmpx # wtmp files are in a binary format, and are intended to be interpreted # by the last command. Rather than try to read them ourselves, we call # last. Subject to usual tags, plus the %f tag stands for the filename. set var wtmp_open_command=last -f %f # don't pipe decompress to the open command, or last will whine about seeking #set var pipe_decompress_to_open= # This is a hook to run arbitrary perl code for each log line before # doing anything else. set arr wtmp_pre_date_hook= @@ifndef __USE_MINIMAL_CONFIG # the second-to-last line of output is always empty. This would cause # it to fail the date_pattern check, so let's skip it in advance. next if m{^$}; @@endif set var wtmp_date_pattern= (?:Sun|Mon|Tue|Wed|Thu|Fri|Sat) ((?:Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec)\s+\d+).* set var wtmp_date_format=%b %e # set arr wtmp_skip_list= # set arr wtmp_raw_rules= @@ifndef __USE_MINIMAL_CONFIG logtype: wtmp pattern: ($pat{file}) begins dest: SKIP pattern: (?:reboot \s+system boot|reboot\s+~) format: reboot dest: major events pattern: ftp\s+ftp\s+($pat{host}) format: $1 dest: FTP: successful FTP from (partial nodename) pattern: ($pat{user})\s+(pts/\d+|tty\w+)\s+($pat{host}) format: $1 from $3 dest: login: successful login for user from (partial nodename) pattern: ($pat{user})\s+(pts/\d+|tty\w+) format: $1 dest: login: successful local login #mta this next guy should probably take advtantage of the X11 info pattern: ($pat{user})\s+(pts/\d+|tty\w+)\s+(\:\d+(?:\.\d+)?) format: $1 dest: login: successful local login @@endif # syslog # This one is kinda scary. add arr log_type_list= syslog # file basenames that this log type applies to set arr syslog_filenames= authlog daemon local1 messages maillog secure syslog set var syslog_date_pattern=^((?:Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec)+\s+\d{1,2})\s+\d+\:\d+\:\d+\s+ set var syslog_date_format=%b %e set var syslog_nodename_pattern=^(\S+)\s* set arr syslog_pre_skip_list_hook= @@ifndef __USE_MINIMAL_CONFIG # get rid of msgid on Solaris hosts s{^(\S+: )\[ID \d+ \w+\.\w+\] }{$1}; # # get rid of PID field, if present s{^([^\s\[]+)\[\d+\]}{$1}; # # for sendmail, get rid of queue ID if (m{^$pat{sendmail_tag}: }) { s{^($pat{sendmail_tag}): $pat{sendmail_queue_id}: }{$1: }; s{^($pat{sendmail_tag}): SYSERR\($pat{user}\): }{$1: SYSERR: }; } @@endif # skip_list and raw_rules are obsolete and deprecated, but will continue # to work. # set arr syslog_skip_list= # set arr syslog_raw_rules= # time for the new config format. Hopefully, this is both more clear and # more extensible. @@ifndef __USE_MINIMAL_CONFIG logtype: syslog # first, a bunch of patterns that we want to skip, AKA discard. pattern: PAM_pwdb: \($pat{word}\) session closed for user $pat{user} dest: SKIP pattern: -- MARK -- dest: SKIP # This one drops all the cron jobs info pattern: /USR/SBIN/CRON: .* dest: SKIP pattern: /usr/sbi/cron: .* dest: SKIP # let's try to recognize kernel device info messages and throw them out: pattern: /bsd: \w+\d at\ dest: SKIP pattern: /bsd: \w+\d:\ dest: SKIP pattern: crosspost: seconds \d+ links \d+ \d+ symlinks \d+ \d+ mkdirs \d+ \d+ missing \d+ toolong \d+ other \d+ dest: SKIP pattern: ftpd: FTP session closed dest: SKIP pattern: ftpd: (?:LIST|CWD|NLST) .* dest: SKIP pattern: ftpd: (?:NOOP|NLST) dest: SKIP pattern: ftpd: PASS password dest: SKIP pattern: ftpd: PORT dest: SKIP pattern: ftpd: PWD dest: SKIP pattern: ftpd: QUIT dest: SKIP pattern: ftpd: REST dest: SKIP pattern: ftpd: SYST dest: SKIP pattern: ftpd: TYPE ASCII dest: SKIP pattern: ftpd: TYPE Image dest: SKIP pattern: ftpd: USER \(none\) dest: SKIP pattern: ftpd: USER ($pat{user}) dest: SKIP pattern: ftpd: User ($pat{user}) timed out after (\d+) seconds at .* dest: SKIP pattern: ftpd: cmd failure dest: SKIP pattern: identd: from: ($pat{ip}) \( ($pat{host}) \) for: (\d+), (\d+) dest: SKIP pattern: identd: from: ($pat{ip}) \(($pat{host})\) EMPTY REQUEST #mta this probably should be flagged, but isn't for now dest: SKIP pattern: identd: from: ($pat{ip}) \(($pat{host})\) for invalid-port\(s\): (\d+) , (\d+) #mta this probably should be flagged, but isn't for now dest: SKIP pattern: identd: Successful lookup: (\d+) , (\d+) : ($pat{user})\.($pat{user}) dest: SKIP pattern: identd: Returned: (\d+) , (\d+) : NO-USER dest: SKIP pattern: $pat{sendmail_tag}: ((?:$pat{host} )?\[($pat{ip})\]) did not issue MAIL/EXPN/VRFY/ETRN during connection to MTA format: $1 dest: host did not issue MAIL/EXPN/VRFY/ETRN during connection pattern: imapd: Authenticated user=($pat{user}) host=($pat{host} \[$pat{ip}\]) format: $1 on $2 dest: imapd: user authenticated pattern: imapd: AUTHENTICATE PLAIN failure host=($pat{host} [$pat{ip}]) format: $1 dest: imapd: authentication failed pattern: imapd: Login disabled user=($pat{user}) auth=($pat{user}) host=($pat{host} \[($ip_pat)\]) format: $1 from $3 dest: imapd: login disabled pattern: imapd: Login failed user=($pat{user}) auth=($pat{user}) host=($pat{host} \[($ip_pat)\]) format: $1 from $3 dest: imapd: login failed pattern: imapd: Login user=($pat{user}) host=($pat{host} \[($ip_pat)\]) format: $1 from $2 dest: imapd: login pattern: imapd: Logout user=($pat{user}) host=($pat{host} \[($ip_pat)\]) format: $1 from $2 dest: imapd: logout pattern: imapd: Killed \(lost mailbox lock\) user=($pat{user}) host=($pat{host} \[$pat{ip}\]) format: $1 on $2 dest: imapd: killed (lost mailbox lock) pattern: imapd: Command stream end of file, while reading line user=($pat{user}) host=($pat{host} \[$pat{ip}\]) format: $1 on $2 dest: imapd: command stream end of file pattern: imapd: Autologout user=($pat{user}) host=($pat{host} \[$pat{ip}\]) format: $1 on $2 dest: imapd: autologout pattern: innd: E dest: SKIP pattern: innd: L:$pat{file} dest: SKIP pattern: innd: ME HISstats \d+ hitpos \d+ hitneg \d+ missed \d+ dne dest: SKIP pattern: kernel: (\s+\w{8}){8} dest: SKIP pattern: kernel: \w+: CDROM not ready\. Make sure there is a disc in the drive\. dest: SKIP pattern: kernel: \w+: Setting promiscuous mode\. dest: SKIP pattern: kernel: Adding Swap: (\d+)k swap-space \(priority (\-?\d+)\) dest: SKIP pattern: kernel: ATAPI device \w+: dest: SKIP pattern: kernel: cdrom: open failed. dest: SKIP pattern: kernel: Detected (\d+(?:\.\d+)?) (?:M|k)?Hz processor\. dest: SKIP pattern: kernel: Detected PS\/2 Mouse Port\. dest: SKIP pattern: kernel: \s+\"(?:\w\w\s){12}\" dest: SKIP pattern: kernel: Device not ready\. Make sure there is a disc in the drive\. dest: SKIP pattern: kernel: Disc change detected dest: SKIP pattern: kernel: EFLAGS: .* dest: SKIP pattern: kernel: EIP: .* dest: SKIP pattern: kernel: Linux version .* dest: SKIP pattern: kernel: Memory: .* dest: SKIP pattern: kernel: Process .* dest: SKIP pattern: kernel: sr0: disc change detected dest: SKIP pattern: kernel: UDF-fs DEBUG .* dest: SKIP pattern: kernel: UDF-fs INFO .* dest: SKIP pattern: kernel: EXT3 .* internal journal dest: SKIP pattern: named-xfer: send AXFR query 0 to ($pat{ip}) dest: SKIP pattern: named: .*(?:Lame server|XSTATS|NSTATS|USAGE|ns_forw|ns_resp).* dest: SKIP pattern: named: .*(?:Cleaned cache|bad referral|points to a CNAME).* dest: SKIP pattern: named: .*(?:all possible.*lame|NS points to CNAME|wrong ans\. name).* dest: SKIP pattern: named: .*(?:send AXFR query| zone .* loaded|sysquery|invalid RR type).* dest: SKIP pattern: named: .*(?:name .* is invalid .* proceeding anyway) dest: SKIP pattern: named: Forwarding source address is .* dest: SKIP pattern: named: invalid RR type .* in authority section dest: SKIP pattern: named: listening on .* dest: SKIP pattern: named: Received NOTIFY answer from .* dest: SKIP pattern: named: Sent NOTIFY for .* dest: SKIP pattern: named: unrelated additional info \'($pat{host})\' type A from \[($pat{ip})\]\.(\d+) dest: SKIP pattern: named: zone transfer .* of .* dest: SKIP pattern: newsyslog: logfile turned over dest: SKIP pattern: ntpdate: step time server dest: SKIP pattern: ofpap: \d+ done dest: SKIP pattern: ofpap: PostScript dest: SKIP pattern: ofpap: done dest: SKIP pattern: ofpap: sending to pap\[\d+\] dest: SKIP pattern: ofpap: starting for \? dest: SKIP pattern: ofpap: straight text dest: SKIP pattern: q?popper: \(v[\d\.]+\) Unable to get canonical name of client,\ err = \d+ dest: SKIP pattern: q?popper: Unable to obtain socket and address of client,\ err = \d+ dest: SKIP pattern: q?popper: warning: can't verify hostname: gethostbyname\($pat{host}\) failed dest: SKIP pattern: q?popper: (?:$pat{mail_user})?\@\[?$pat{host}\]?: -ERR POP EOF received dest: SKIP pattern: q?popper: (?:$pat{mail_user})?\@\[?$pat{host}\]?: -ERR POP hangup dest: SKIP pattern: q?popper: (?:$pat{mail_user})?\@\[?$pat{host}\]?: -ERR POP timeout dest: SKIP pattern: q?popper: (?:$pat{mail_user})?\@\[?$pat{host}\]?: -ERR SIGHUP or SIGPIPE flagged dest: SKIP pattern: savecore: no core dump dest: SKIP pattern: $pat{sendmail_tag}: $pat{file}: \d+ aliases, longest \d+ bytes, \d+ bytes total dest: SKIP pattern: $pat{sendmail_tag}: Authentication-Warning: $pat{host}: $pat{mail_user} set sender to dest: SKIP pattern: $pat{sendmail_tag}: Authentication-Warning: $pat{host}: $pat{mail_user}\@$pat{host} didn't use HELO protocol dest: SKIP pattern: $pat{sendmail_tag}: alias database $pat{file} (?:auto|)rebuilt by $pat{mail_user} dest: SKIP pattern: $pat{sendmail_tag}: clone ($pat{sendmail_queue_id}), owner\=($pat{mail_user}(?:\@$pat{host})?) dest: SKIP pattern: $pat{sendmail_tag}: $pat{sendmail_queue_id}: clone: owner=$pat{mail_user} dest: SKIP pattern: $pat{sendmail_tag}: collect: premature EOM: Error \d+ dest: SKIP pattern: $pat{sendmail_tag}: gethostbyaddr\($pat{ip}\) failed: .* dest: SKIP pattern: $pat{sendmail_tag}: gethostbyaddr: $pat{host} != $pat{ip} dest: SKIP pattern: $pat{sendmail_tag}: to=.*stat=(?:Sent|queued).* dest: SKIP pattern: $pat{sendmail_tag}: from=.* dest: SKIP pattern: $pat{sendmail_tag}: \w+: DSN: .* dest: SKIP pattern: $pat{sendmail_tag}: \w+: return to sender: .* dest: SKIP pattern: sshd: Connection closed by $pat{ip} dest: SKIP pattern: sshd: Generating 768 bit RSA key. dest: SKIP pattern: sshd: Generating new 768 bit RSA key. dest: SKIP pattern: sshd: RSA key generation complete. dest: SKIP pattern: sshd: fatal: Connection closed by remote host\. dest: SKIP pattern: sshd: fatal: Could not write ident string\. dest: SKIP pattern: sshd: fatal: Did not receive ident string\. dest: SKIP pattern: sshd: fatal: Local: Command terminated on signal \d+\. dest: SKIP pattern: sshd: fatal: Read error from remote host: Connection timed out dest: SKIP pattern: sshd: fatal: Read error from remote host: Connection reset (?:by peer)? dest: SKIP pattern: sshd: fatal: Read error from remote host: No route to host dest: SKIP pattern: sshd: fatal: Read from socket failed: Connection reset by peer dest: SKIP pattern: sshd: fatal: Read from socket failed: No route to host dest: SKIP pattern: sshd: fatal: Session canceled by user dest: SKIP pattern: sshd: fatal: Write failed: Broken pipe dest: SKIP pattern: sshd: fatal: Timeout before authentication\. dest: SKIP pattern: sshd: fatal: Timeout before authentication for ($pat{ip})\. dest: SKIP pattern: sshd: log: Closing connection to ($pat{ip}) dest: SKIP pattern: sshd: log: fwd X11 connect from dest: SKIP pattern: sshd: log: Generating \d+ bit RSA key. dest: SKIP pattern: sshd: log: Generating new (\d+) bit RSA key\. dest: SKIP pattern: sshd: log: RhostsRsa authentication not available for connections from unprivileged port\. dest: SKIP pattern: sshd: log: Rsa authentication refused for $pat{user}: no $pat{file}/\.ssh\s dest: SKIP pattern: sshd: log: RSA key generation complete\. dest: SKIP pattern: sshd: log: Server listening on port 22. dest: SKIP pattern: sshd: log: Setting tty modes failed dest: SKIP pattern: sshd: log: Wrong response to RSA authentication challenge. dest: SKIP pattern: sshd: log: executing remote command as user ($pat{user}) dest: SKIP pattern: snmpd\w.*: local pdu process error dest: SKIP pattern: snmpd\w.*: session_send_loopback_request\(\) failed dest: SKIP pattern: snmpd\w*: session_open\(\) failed for a pdu received from dest: SKIP pattern: su: Authentication failed for $pat{user} dest: SKIP pattern: sudo:\s+ $pat{user} : \(command continued\) .* dest: SKIP pattern: traceroute: gethostbyaddr: .* dest: SKIP pattern: unix: dest: SKIP pattern: unix: : dest: SKIP pattern: unix: \t\ dest: SKIP pattern: unix: Copyright \(c\) 1983-1997\, Sun Microsystems\, Inc\. dest: SKIP pattern: unix: Ethernet address \= ((?:\w+\:){5}\w+) dest: SKIP pattern: unix: \w+ is .* dest: SKIP pattern: unix: SUNW\,\w+ is .* dest: SKIP pattern: unix: \w+ at .* dest: SKIP pattern: unix: SUNW\,\w+ at .* dest: SKIP pattern: unix: \w+: screen \w+x\w+, (?:single|double) buffered, \w+ mappable, rev \w+ dest: SKIP pattern: unix: MMCODEC: Manufacturer id \w+, Revision \w+ dest: SKIP pattern: unix: No contiguous memory requested for SX dest: SKIP pattern: unix: SBus level \d+ dest: SKIP pattern: unix: SBus slot \w+ 0x\w+ dest: SKIP pattern: unix: SunOS Release ([\d\.]+) Version .* dest: SKIP pattern: unix: avail mem = \w+ dest: SKIP pattern: unix: cpu \d+ initialization complete - online dest: SKIP pattern: unix: cpu\w+: \w+,\w+ \(mid \w+ impl 0x\w+ ver 0x\w+ clock \w+ MHz\) dest: SKIP pattern: unix: dump on /dev/dsk/\w+ size \w+ dest: SKIP pattern: unix: esp\w+:\s+esp-options=0x\w+ dest: SKIP pattern: unix: mem = \w+ \(0x\w+\) dest: SKIP pattern: unix: pac: enabled - SuperSPARC/SuperCache dest: SKIP pattern: unix: pseudo-device: pm\w+ dest: SKIP pattern: unix: pseudo-device: vol\w+ dest: SKIP pattern: unix: root nexus = SUNW,SPARCstation-\d+ dest: SKIP pattern: unix: root on /iommu@\w+,\w+/sbus@\w+,\w+/espdma@\w+,\w+/esp@\w+,\w+/sd@\w+,\w+:a fstype ufs dest: SKIP pattern: unix: sparc ipl \d+ dest: SKIP pattern: unix: syncing file systems... done dest: SKIP pattern: unix: syncing file systems...SunOS Release \d+\.\d+ dest: SKIP pattern: unix: vac: enabled dest: SKIP pattern: x?ntpd: tickadj \= (\d+), tick = (\d+), tvu_maxslew = (\d+) dest: SKIP pattern: x?ntpd: time reset .* dest: SKIP pattern: x?ntpd: x?ntpd [\d\-\.]+ dest: SKIP pattern: x?ntpd: precision = \d+ usec dest: SKIP pattern: x?ntpd: synchronisation lost dest: SKIP pattern: x?ntpd: synchronized to $pat{ip}, stratum=\d+ dest: SKIP pattern: x?ntpd: synchronized to LOCAL\(0\), stratum=\d+ dest: SKIP pattern: /usr/dt/bin/ttsession: child \(\d+\) exited due to signal \d+ dest: SKIP pattern: /usr/dt/bin/ttsession: exiting dest: SKIP # OK, now let's have a bunch of useful rules. pattern: (kernel: device \w+ (?:entered|left) promiscuous mode|lpd: lpd shutdown succeeded|named: Ready to answer queries|named: deleting interface \[($pat{ip})\]\.\d+|named: named shutting down|named: reloading nameserver|named: starting|reboot: rebooted by \w+|rpcbind: rpcbind terminating on signal|$pat{sendmail_tag}: (?:sendmail )?(?:startup|shutdown|restarting|rejecting).*|$pat{sendmail_tag}: starting daemon|sshd: error: Bind to port \d+ on $pat{ip} failed: Address already in use.|sshd: Received signal 15; terminating.|sshd: fatal: Cannot bind any address.|sshd: log: Received signal \d+; terminating|shutdown: reboot by .*|sshd: Received SIGHUP; restarting\.|sshd: Server listening on $pat{ip} port \d+\.|syslogd(?: [\d\.\-\#]+)?: restart|syslogd: configuration restart|syslogd: (?:going down|exiting) on signal \d+|unix: BAD TRAP|x?ntpd: x?ntpd exiting on signal \d+).* format: $1 dest: major events pattern: (inetd: /usr/openwin/bin/Xaserver: Hangup|named: $pat{file}:\d+:.*|$pat{sendmail_tag}: alias database $pat{file} out of date|kernel: EXT2\-fs error \(device [\w\:]+\):|$pat{sendmail_tag}: SYSERR: Cannot create database for alias file .*|$pat{sendmail_tag}: SYSERR: dbm map .*|$pat{sendmail_tag}: SYSERR: MX list for .* points back to .*|$pat{sendmail_tag}: unable to write ${pat{file}}|$pat{sendmail_tag}: forward $pat{file}\+?: Group writable directory|sshd: error: bind: Address already in use|sshd: fatal: Bind to port \d+ failed: Address already in use.|x?ntpd: can't open $pat{file}:.*) format: $1 dest: stuff that might need fixing pattern: (kernel: end_request: I/O error,\ dev [^\,]+),\ sector \d+ format: $1 dest: stuff that might need fixing pattern: kernel: Out of Memory: Killed process (\d+) \(($pat{file})\)\. format: kernel: out of memory, killed process $2 dest: stuff that might need fixing pattern: $pat{sendmail_tag}: .*: (cannot open $pat{file}: Group writable directory) format: $1 dest: stuff that might need fixing pattern: ofpap: \d+ died with (\d+) format: ofpap: died with $1 dest: stuff that might need fixing pattern: (?:in\.)?ftpd: refused connect from ($pat{host}) format: $1 dest: FTP: refused connection from pattern: (?:in\.)?ftpd: connect(?:ion)? from ($pat{host})(?: \[$pat{ip}\])? format: $1 dest: FTP: connection from pattern: ftpd: ANONYMOUS FTP LOGIN FROM ($pat{host}) \[($pat{ip})\],\ ($pat{user}(?:\@(?:$pat{host}|)|)) format: $3 from $1 ($2) dest: FTP: anonymous login pattern: ftpd: ANONYMOUS FTP LOGIN FROM ($pat{host}) \[($pat{ip})\],? format: unknown from $1 ($2) dest: FTP: anonymous login pattern: mountd: refused mount request from ($pat{host}) format: $1 dest: NFS: refused with pattern: mountd: authenticated mount request from ($pat{host}):\d+ format: $1 dest: NFS: authorized NFS with pattern: mountd: authenticated unmount request from ($pat{host}):\d+ format: $1 dest: NFS: authorized NFS with pattern: PAM_pwdb: \(login\) session opened for user ($pat{user})\s+ format: $1 dest: login: successful login pattern: ipmon: \d+:\d+:\d+\.\d+(?:\s*\d+x)? +(\w+) \@\d+:\d+ b ($host_pat)\,([\w\-]+) -> ($host_pat)\,([\w\-]+) PR (\w+) len \d+ \d+.*$ format: $2 => $4 $6 $5 dest: ipmon: blocked packet pattern: ipmon: \d+:\d+:\d+\.\d+(?:\s*\d+x)? +(\w+) \@\d+:\d+ b ($host_pat) -> ($host_pat) PR (icmp) len \d+ \d+ icmp (\w+\/\w+) .*$ format: $2 => $3 $4 $5 dest: ipmon: blocked packet pattern: ipmon: \d+:\d+:\d+\.\d+(?:\s*\d+x)? +(\w+) \@\d+:\d+ b ($host_pat) -> ($host_pat) PR (\d+) len \d+ \(\d+\) IN.*$ format: $2 => $3 proto-$4 dest: ipmon: blocked packet pattern: kernel: IP fw-in deny \w+ (\w+) ($pat{ip}):(\d+) ($pat{ip}):(\d+) format: $1 $2 => $4:$5 dest: CATEGORY kernel: firewall deny format: $2, $4 dest: UNIQUE scans pattern: kernel: Packet log: inp(?:ut)? DENY \w+ PROTO=17 ($pat{ip}):(\d+) ($pat{ip}):(\d+) .* use_sprintf format: "%-15s => %-15s UDP %-5s", $1, $3, $4 dest: CATEGORY kernel: firewall deny format: $1, $3 dest: UNIQUE scans pattern: kernel: Packet log: inp(?:ut)? DENY \w+ PROTO=1 ($pat{ip}):(\d+) ($pat{ip}):(\d+) .* use_sprintf format: "%-15s => %-15s ICMP %-5s", $1, $3, $2 dest: CATEGORY kernel: firewall deny format: $1, $3 dest: UNIQUE scans pattern: kernel: Packet log: inp(?:ut)? DENY \w+ PROTO=6 ($pat{ip}):(\d+) ($pat{ip}):(\d+) .* use_sprintf format: "%-15s => %-15s TCP %-5s", $1, $3, $4 dest: CATEGORY kernel: firewall deny format: $1, $3 dest: UNIQUE scans pattern: kernel: Packet log: inp(?:ut)? DENY \w+ PROTO=2 ($pat{ip}):(\d+) ($pat{ip}):(\d+) .* use_sprintf format: "%-15s => %-15s IGMP %-5s", $1, $3, $4 dest: CATEGORY kernel: firewall deny format: $1, $3 dest: UNIQUE scans pattern: kernel: Packet log: inp(?:ut)? REJECT \w+ PROTO=17 ($pat{ip}):(\d+) ($pat{ip}):(\d+) .* use_sprintf format: "%-15s => %-15s UDP %-5s", $1, $3, $4 dest: CATEGORY kernel: firewall reject format: $1, $3 dest: UNIQUE scans pattern: kernel: Packet log: inp(?:ut)? REJECT \w+ PROTO=1 ($pat{ip}):(\d+) ($pat{ip}):(\d+) .* use_sprintf format: "%-15s => %-15s ICMP %-5s", $1, $3, $2 dest: CATEGORY kernel: firewall reject format: $1, $3 dest: UNIQUE scans pattern: kernel: Packet log: inp(?:ut)? REJECT \w+ PROTO=6 ($pat{ip}):(\d+) ($pat{ip}):(\d+) .* use_sprintf format: "%-15s => %-15s TCP %-5s", $1, $3, $4 dest: CATEGORY kernel: firewall reject format: $1, $3 dest: UNIQUE scans pattern: kernel: Packet log: inp(?:ut)? REJECT \w+ PROTO=2 ($pat{ip}):(\d+) ($pat{ip}):(\d+) .* use_sprintf format: "%-15s => %-15s IGMP %-5s", $1, $3, $4 dest: CATEGORY kernel: firewall reject format: $1, $3 dest: UNIQUE scans # this next one contributed by Tim Meushaw and modified pattern: pattern: kernel: Denied Packet:.* SRC=($pat{ip}) DST=($pat{ip}).* PROTO=([A-Z]+) SPT=(\d+) DPT=(\d+) .* use_sprintf format: "%-15s => %-15s %-5s %-5s", $1, $2, $3, $5 dest: CATEGORY kernel: firewall deny format: $1, $2 dest: UNIQUE scans pattern: kernel: IN=($pat{word})? OUT=($pat{word})? MAC=($pat{mac}):($pat{mac}):([[:xdigit:]]{2}:[[:xdigit:]]{2}) SRC=($pat{ip}) DST=($pat{ip}) LEN=(\d+) TOS=0x([[:xdigit:]]{2}) PREC=0x([[:xdigit:]]{2}) TTL=(\d+) ID=(\d+) (DF )?PROTO=(\w+) SPT=(\d+) DPT=(\d+).* use_sprintf: format: "%-15s => %-15s %-5s %-5s", $6, $7, $14, $16 dest: kernel: firewall deny format: $6, $7 dest: UNIQUE scans pattern: kernel: IN=($pat{word})? OUT=($pat{word})? MAC=($pat{mac}):($pat{mac}):([[:xdigit:]]{2}:[[:xdigit:]]{2}) SRC=($pat{ip}) DST=($pat{ip}) LEN=(\d+) TOS=0x([[:xdigit:]]{2}) PREC=0x([[:xdigit:]]{2}) TTL=(\d+) ID=(\d+) (DF )?PROTO=(\w+) TYPE=(\d+) CODE=(\d+).* use_sprintf: format: "%-15s => %-15s %-5s %-5s", $6, $7, $14, $15 dest: kernel: firewall deny format: $6, $7 dest: UNIQUE scans pattern: login: invalid password for \`($pat{user})\' on \`($pat{file})\' format: $1 dest: login: authentication failure for pattern: login: invalid password for \`($pat{user})\' on \`($pat{file})\' from \`($pat{host})\' format: $1 dest: login: authentication failure for pattern: login: LOGIN ON ($pat{file}) BY ($pat{user}) format: $2 dest: login: successful local login pattern: login: FAILED LOGIN \d+ FROM \($pat{host}\) FOR ($pat{user}),\ Authentication failure format: $1 dest: login: authentication failure for pattern: named: zone $pat{zone}/IN: loaded serial $pat{int} dest: SKIP pattern: named.*Zone "($pat{zone})".* No default TTL set using SOA minimum instead format: $1 dest: named: no default TTL (bind 8.2) pattern: named.*Err/TO getting serial# for "($pat{zone})" format: $1 dest: named: serial number errors for zone pattern: named.*Zone "($pat{zone})" \(IN\) SOA serial\# \(\d+\) rcvd from \[($pat{ip})\] is \< ours format: $2 for $1 dest: named: master has serial number too low for zone pattern: named-xfer: serial from \[($pat{ip})\],\ zone ($pat{zone})\: \d+ lower than current\: \d+ format: $1 for $2 dest: named: master has serial number too low for zone pattern: named-xfer: \[($pat{ip})\] not authoritative for ($pat{zone})\, format: $1 for $2 dest: named: master server is not authoritative for zone pattern: named-xfer: connect\(($pat{ip})\) for zone ($pat{zone}) failed: (.*) format: $1 for $2 dest: named: connect to master server for zone failed pattern: named-xfer\: \[\[($pat{ip})\].\d+\] transfer refused from \[($pat{ip})\]\,\ zone ($pat{zone}) format: $3 from $2 dest: named: we were refused transfer #mta take advantage of zone info pattern: (?:$pat{file})?named: unapproved AXFR from \[($pat{ip})\]\.(\d+) for \"($pat{zone})\" \(acl\) format: $1 dest: named: unapproved zone transfer requested by pattern: (?:$pat{file})?named: denied AXFR from \[($pat{ip})\]\.(\d+) for \"($pat{zone})\" \(acl\) format: $1 for $3 dest: named: unapproved zone transfer requested by pattern: (?:$pat{file})?named: client ($pat{ip})\#(\d+): zone transfer denied format: $1 dest: named: unapproved zone transfer requested by pattern: (?:$pat{file})?named: unapproved update from \[($pat{ip})\] format: $1 dest: named: unapproved update from #mta: this next guy should probably display the zone pattern: (?:$pat{file})?named: approved AXFR from \[($pat{ip})\]\.(\d+) for \"($pat{zone})\" format: $1 dest: named: approved zone transfer requested by pattern: (?:$pat{file})?named: client ($ip_pat)\#($pat{port}): transfer of \'($pat{zone})\': AXFR started format: $1 dest: named: zone transfer started to pattern: (?:$pat{file})?named: zone ($pat{zone}): refresh: failure trying master ($pat{ip})\#($pat{port}): timed out format: $2 for $1 dest: named: AXFR timed out pattern: (?:$pat{file})?named: zone ($pat{zone}): refresh: retry limit for master ($ip_pat)\#($pat{port}) exceeded format: $2 for $1 dest: named: retry limit for zone exceeded pattern: (?:$pat{file})?named: Response from unexpected source \(\[($pat{ip})\]\.(\d+)\) format: $1 dest: named: responses from unexpected sources pattern: (?:$pat{file})?named: Malformed response from \[($pat{ip})\]\.(\d+) \((.*)\) format: $1 dest: named: malformed response pattern: (?:$pat{file})?named: unapproved query from \[($pat{ip})\]\.\d+ for \"($pat{host})\" format: $1 for $2 dest: named: unapproved query pattern: (?:$pat{file})?named: creating IPv4 interface ([\w\:]+) failed; interface ignored format: $1 dest: named: creating IPv4 interface failed; interface ignored pattern: (?:$pat{file})?named: client ($ip_pat)\#($pat{port}): update forwarding denied format: $1 dest: named: client update forwarding denied pattern: (?:$pat{file})?named: client ($ip_pat)\#($pat{port}): update '($pat{zone})' denied format: $1 dest: named: client update denied pattern: (?:$pat{file})?named: zone ($pat{zone}): transferred serial (\d+) format: $1 dest: named: successfully transferred zone pattern: (?:$pat{file})?named: client ($ip_pat)\#($pat{port}): transfer of '($pat{zone})': send: socket is not connected format: $1 for $3 dest: named: transfer failed: socket is not connected pattern: (?:$pat{file})?named: transfer of '($pat{zone})' from ($pat{ip})\#($pat{port}): end of transfer format: $2 for $1 dest: named: zone transfer completed pattern: (?:$pat{file})?named: zone ($pat{zone}): refresh: failure trying master ($pat{ip})#($pat{port}): operation canceled format: $2 for $1 dest: named: refresh failure trying master: operation cancelled pattern: (?:$pat{file})?named: loading configuration from '($pat{file})' dest: SKIP pattern: (?:$pat{file})?named: zone ($pat{zone}): refresh: non-authoritative answer from master ($pat{ip})\#($pat{port}) format: $2 for $1 dest: named: non-authoritative answer from zone master pattern: sshd: Accepted hostbased for ($user_pat) from ($ip_pat) port (\d+) ssh2 format: $1 from $2 dest: sshd: accepted hostbased pattern: $pat{named_tag}: client ($pat{ip})\#($pat{port}): transfer of '($pat{zone})': AXFR-style IXFR started format: $1 for $3 dest: named: AXFR-style IXFR started pattern: named: client ($pat{ip})\#($pat{port}): updating zone '($pat{zone})': update failed: 'RRset exists \(value dependent\)' prerequisite not satisfied \(NXRRSET\) format: $1 for $3 dest: named: update failed; RRset does not even exist pattern: nscd: gethostbyaddr: ($pat{host}) \!\= ($pat{ip}) format: $1 != $2 dest: nscd: host/IP mismatch pattern: pam_tally: user ($pat{user}) \((\d+)\) tally (\d+),\ deny (\d+) format: $1 ($2) limit $4 dest: pam_tally: user attempting login after exceeding login failure limit pattern: q?popper: ($pat{mail_user})\@\[?($pat{host})\]?: -ERR (?:authentication failure|Password supplied for "$pat{mail_user}" is incorrect\.?|not authorized) format: $1\@$2 dest: popper: authentication failure pattern: q?popper: Failed attempted login to ($pat{user}) from host ($pat{host}) format: $1\@$2 dest: popper: authentication failure pattern: q?popper: ($pat{user})\@$pat{host}: -ERR $pat{file} lock busy\! Is another session active\? \(11\) format: $1 dest: popper: POP lock for pattern: q?popper: Stats: ($pat{mail_user}) (\d+) (\d+) (\d+) (\d+) format: $1 dest: popper: users checked mail pattern: q?popper: Stats: ($pat{mail_user}) (\d+) (\d+) (\d+) (\d+) ($pat{host}) ($pat{ip}) format: $1 dest: popper: users checked mail pattern: q?popper: apop \"($pat{mail_user})\"\s* format: $1 dest: popper: user is using apop pattern: q?popper: ($pat{mail_user})\@\[?($pat{host})\]?: -ERR You must use APOP to connect to this server format: $1\@$2 dest: popper: should have used APOP pattern: q?popper: @($pat{host}): -ERR Too few arguments for the auth command. format: $1 dest: popper: too few arguments for the auth command pattern: q?popper: ((?:$pat{user})?\@$pat{host}): -ERR Unknown command: "(\w+)". format: $2 from $1 dest: popper: unknown command from pattern: unix: NOTICE: quota_ufs: (?:Warning: over disk|over disk and time|over hard disk) limit \(pid \d+,\ uid (\d+), inum (\d+), fs ($pat{file})\)(?:\^M)? format: $1 dest: quota exceeded (user's UID) pattern: $pat{sendmail_tag}: to=([^\,]+)\,.*stat=(unknown mailer error) format: '$1' got '$2' dest: sendmail: delivery failed pattern: $pat{sendmail_tag}: to=([^\,]+)\,.*stat=Deferred[^\,]* format: '$1' dest: sendmail: delivery deferred pattern: $pat{sendmail_tag}: to=([^\,]+)\,.*stat=(.*) format: '$1' got '$2' dest: sendmail: delivery failed pattern: $pat{sendmail_tag}: \<([^\>]+)\>\.\.\.\s*(.*\S) format: '$1' got '$2' dest: sendmail: delivery failed pattern: $pat{sendmail_tag}: ruleset=check_mail,\ arg1=\?,\ relay=([^\,]+),\ reject\=.*(Sender domain.*|DENY) format: from user '$1' from server '$2' because '$3' dest: sendmail: we rejected incoming mail pattern: $pat{sendmail_tag}: ruleset=check_mail,\ arg1=([^\,]+),\ relay=([^\,]+),\ reject\=.*(Domain name required).* format: from user '$1' from server '$2' because '$3' dest: sendmail: we rejected incoming mail pattern: $pat{sendmail_tag}: ruleset=check_rcpt,\ arg1=([^\,]+),\ relay=([^\,]+),\ reject=.*\.\.\.\s*(.*\S) format: from user '$1' from server '$2' because '$3' dest: sendmail: we rejected incoming mail pattern: $pat{sendmail_tag}: timeout waiting for input from ($pat{host}) .* format: $1 dest: sendmail: communications problems with pattern: $pat{sendmail_tag}: lost input channel from (.*) format: '$1' dest: sendmail: communications problems with pattern: $pat{sendmail_tag}: (?:SYSERR: )?collect: (?:I\/O error on connection from|premature EOM: Connection reset by|unexpected close on connection from) ($pat{host}|\[$pat{ip}\]).* format: '$1' dest: sendmail: communications problems with pattern: $pat{sendmail_tag}: Null connection from (.*) format: '$1' dest: sendmail: Null connect from pattern: $pat{sendmail_tag}: ((?:IDENT:)?[^\:\,]+): expn ($pat{mail_user}) \[rejected\] format: '$1' expnd '$2' dest: sendmail: expn rejected pattern: $pat{sendmail_tag}: ((?:IDENT:)?[^\:\,]+): expn ($pat{mail_user}) format: '$1' expnd '$2' dest: sendmail: expn allowed pattern: $pat{sendmail_tag}: ((?:IDENT:)?[^\:\,]+): vrfy ($pat{mail_user}) \[rejected\] format: '$1' vrfyd '$2' dest: sendmail: vrfy rejected pattern: $pat{sendmail_tag}: ((?:IDENT:)?[^\:\,]+): vrfy ($pat{mail_user}) format: '$1' vrfyd '$2' dest: sendmail: vrfy allowed pattern: $pat{sendmail_tag}: Authentication-Warning: ($pat{host}): ($pat{mail_user}) set sender to ($pat{mail_user})\@($pat{host}) using -f dest: SKIP pattern: sshd: log: Unknown group id (\d+) format: $1 dest: sshd: login to unknown group (check /etc/passwd) pattern: sshd: Could not reverse map address ($pat{ip})\. format: $1 dest: sshd: could not reverse map address pattern: sshd: log: Connection for ($pat{user}) not allowed from ($pat{host}) format: $1 from $2 dest: sshd: denied access pattern: sshd: Did not receive ident string from ($pat{ip})\. format: $1 dest: sshd: did not receive ident string from host pattern: sshd: log: Connection from ($pat{ip}) port (\d+) format: $1 dest: sshd: connection from pattern: sshd: log: (?:RSA|Password) authentication for ($pat{user}) accepted\.? format: $1 dest: sshd: authentications for pattern: sshd: log: Rhosts with RSA host authentication accepted for ($pat{user}),\ ($pat{user}) on ($pat{host})\. format: $1 from $2\@$3 dest: sshd: authentications for pattern: sshd: log: Could not reverse map address ($pat{ip})\. format: $1 dest: sshd: could not reverse map pattern: sshd: Failed keyboard-interactive for ($pat{user}) from ($pat{ip}) port \d+ format: $1 from $2 dest: sshd: failed keyboard-interactive pattern: sshd: Failed password for ($pat{user}) from ($pat{ip}) port \d+ format: $1 from $2 dest: sshd: failed password pattern: sshd: Accepted password for ($pat{user}) from ($pat{ip}) port \d+(?:\s+ssh2)? format: $1 from $2 dest: sshd: accepted password pattern: sshd: Accepted publickey for ($pat{user}) from ($pat{ip}) port \d+(?:\s+ssh2)? format: $1 from $2 dest: sshd: accepted publickey pattern: sshd: Accepted rsa for ($pat{user}) from ($pat{ip}) port \d+ format: $1 from $2 dest: sshd: accepted rsa pattern: sshd: Faking authloop for illegal user ($pat{user}) from ($pat{ip}) port (\d+) format: $1 from $2 dest: sshd: illegal user pattern: su\: \'su ($pat{user})\' failed for ($pat{user}) on ($pat{file}) format: $2 => $1 dest: su: failed for pattern: su\: \'su ($pat{user})\' succeeded for ($pat{user}) on ($pat{file}) format: $2 => $1 dest: su: succeeded for pattern: su: \- $pat{file} ($pat{user})-($pat{user}) format: $1 => $2 dest: su: failed for pattern: su: \+ $pat{file} ($pat{user})-($pat{user}) format: $1 => $2 dest: su: succeeded for pattern: PAM_pwdb: \(su\) session opened for user ($pat{user}) by ($pat{user}) format: $2 => $1 dest: su: succeeded for pattern: PAM_pwdb: \d+ authentication failure\;\ ($pat{user})\(uid=\d+\) \-\> ($pat{user}) for su service format: $1 => $2 dest: su: failed for pattern: su: ($pat{user}) to ($pat{user}) on $pat{file} format: $1 => $2 dest: su: succeeded for pattern: sudo:\s*($pat{user}) : user NOT in sudoers ; TTY=$pat{file} ; PWD=$pat{file} ; USER=$pat{user} ; COMMAND=($pat{file}).* format: $1 ran $2 dest: sudo: unauthorized user ran command pattern: sudo:\s+($pat{user}) : TTY=$pat{file} ; PWD=$pat{file} ; USER=$pat{user} ; COMMAND=($pat{file}).* format: $1 ran $2 dest: sudo: authorized user ran command pattern: sudo:\s+($pat{user}) : (?:3 incorrect passwords|password incorrect) ; TTY=$pat{file} ; PWD=$pat{file} ; USER=$pat{user} ; COMMAND=($pat{file}).* format: $1 ran $2 dest: sudo: incorrect password pattern: snmpdx?: agent_process\(\) : bad community from ($pat{ip}) format: $1 dest: snmpd: bad community from pattern: identd: Connection from ($pat{host}) format: $1 dest: identd: connection from pattern: ([^\:\s]+): refused connect from (.*\S) format: $1 from $2 dest: service refused connection pattern: ([^\:\s]+): connect from (.*\S) format: $1 from $2 dest: service allowed connection pattern: tftpd: tftpd: trying to get file: ($pat{file}) format: $1 dest: tftpd: trying to get file # bind says a "user@host:/somedir/named" when it starts pattern: $pat{user}\@$pat{host}:$pat{file}/named format: named started dest: major events # OpenBSD says a "user@host:/somedir/GENERIC" when it starts pattern: /bsd:\s*$pat{user}\@$pat{host}:$pat{file}/GENERIC format: booted dest: major events pattern: spamd: info: setuid to ($user_pat) succeeded dest: SKIP pattern: spamd: connection from ($host_pat) \[($ip_pat)\] at port (\d+) dest: SKIP pattern: clamav-milter: ($pat{sendmail_queue_id}): clean message from <($mail_user_pat\@$host_pat)> dest: SKIP pattern: clamav-milter: ($pat{sendmail_queue_id}): Intercepted virus from <($pat{mail_address})> to <($pat{mail_address})> format: from $2 to $3 dest: clamav-milter: intercepted virus pattern: clamav-milter: ($pat{sendmail_queue_id}): stream: (.*) FOUND Intercepted virus from <($pat{mail_address})> to <($pat{mail_address})> format: from $4 to $3 dest: clamav-milter: intercepted virus pattern: clamav-milter: stream: ($file_pat) FOUND format: $1 dest: clamav-milter found virus pattern: clamd: stream: ($file_pat) FOUND format: $1 dest: clamd found virus pattern: ($pat{sendmail_tag}): Milter (?:add|change|delete): .* dest: SKIP pattern: ($pat{sendmail_tag}): ($pat{user})\@?($host_pat) \[($pat{ip})\]\: ETRN ($pat{zone}) format: $5 from $4 dest: sendmail: received ETRN from IP # this looks like some sort of continuation thing. pattern: ($pat{sendmail_tag}): ($pat{sendmail_queue_id})\[([2-9]|\d\d+)\]:.* dest: SKIP pattern: spamd: clean message \((\d+\.\d+)/(\d+\.\d+)\) for ($user_pat):(\d+) in (\d+\.\d+) seconds, (\d+) bytes. dest: SKIP pattern: spamd: identified spam \((\d+\.\d+)/(\d+\.\d+)\) for ($user_pat):(\d+) in (\d+\.\d+) seconds, (\d+) bytes. format: $3 dest: spamd: identified spam sent for user pattern: spamd: processing message (.*) for ($user_pat):(\d+)\. dest: SKIP pattern: spamd: processing message \(unknown\) for ($user_pat):(\d+)\. dest: SKIP pattern: clamd: Database correctly reloaded \((\d+) viruses\) dest: SKIP pattern: clamd: Reading databases from ($file_pat) dest: SKIP pattern: clamd: SelfCheck: Database modification detected. Forcing reload. dest: SKIP pattern: clamd: SelfCheck: Database status OK. dest: SKIP pattern: named: transfer of \'($zone_pat)/IN\' from ($pat{ip})\#($pat{port}): failed while receiving responses: (.*) format: $1 from $2 error $4 dest: named: transfer failed pattern: (spamd: Still running as ($pat{user}): user not specified with -u, not found, or set to ($pat{user}). Fall back to ($pat{user}).) format: $1 dest: stuff that might need fixing pattern: (sshd: rexec line ($pat{int}): Deprecated option .*) format: $1 dest: stuff that might need fixing pattern: sshd: input_userauth_request: (?:illegal|invalid) user ($pat{user}) format: $1 #dest: sshd: input_userauth_request: illegal user # personally, I think this should be a SKIP dest: SKIP pattern: sshd: Failed password for (?:illegal|invalid) user ($pat{user}) from ($pat{ip}) port ($pat{port}) ($pat{ssh_id}) format: $1 from $2 delete_if_unique dest: sshd: failed password for invalid user format: "$2 ssh user", $1 dest: UNIQUE scans pattern: sshd: (?:Illegal|Invalid) user ($pat{user}) from ($pat{ip}) format: $1 from $2 delete_if_unique dest: sshd: invalid user format: "$2 ssh user", $1 dest: UNIQUE scans pattern: sshd: Failed password for ($pat{user}) from ($pat{ip}) port ($pat{port}) ($pat{ssh_id}) format: $1 from $2 delete_if_unique dest: sshd: user failed password format: "$2 ssh user", $1 dest: UNIQUE scans pattern: kernel: (($pat{word}): link up)\, ($pat{anything}) dest: SKIP pattern: sshd: fatal: Timeout before authentication for ($pat{ip}) format: $1 dest: CATEGORY sshd: timeout before authentication pattern: postfix\/trivial\-rewrite: table ($pat{anything}) has changed \-\- restarting dest: SKIP pattern: postfix\/qmgr: 5886610385E: from\=\<($pat{mail_address})\>\, status\=expired\, returned to sender format: $1 dest: CATEGORY email: bounced pattern: postfix\/scache: statistics: address lookup hits\=($pat{int}) miss\=($pat{int}) success\=($pat{int})\% dest: SKIP pattern: postfix\/scache: statistics: max simultaneous domains\=($pat{int}) addresses\=($pat{int}) connection\=($pat{int}) dest: SKIP pattern: kernel: (($pat{word}): link down) format: $1 dest: CATEGORY stuff that might need fixing pattern: postfix\/smtpd: NOQUEUE: reject: RCPT from ($pat{host})\[($pat{ip})\]: 550 \<($pat{mail_address})\>: Recipient address rejected: User unknown in local recipient table\; from\=\<($pat{mail_address})\> to\=\<($pat{mail_address})\> proto\=ESMTP helo\=\<($pat{host})\> format: $3 dest: CATEGORY email: unknown user pattern: sshd: User ($pat{user}) not allowed because shell ($pat{anything}) does not exist format: $1 dest: CATEGORY sshd: user not allowed because shell does not exist pattern: sshd: User ($pat{user}) not allowed because shell ($pat{file}) is not executable format: $1 dest: CATEGORY sshd: user not allowed because shell is not executable pattern: postfix\/scache: statistics: domain lookup hits\=($pat{int}) miss\=($pat{int}) success\=($pat{int})\% dest: SKIP pattern: postfix\/scache: statistics: start interval ($pat{anything}) dest: SKIP pattern: sshd: User ($pat{user}) not allowed because account is locked format: $1 dest: CATEGORY sshd: user not allowed because account is locked pattern: sshd: User ($pat{user}) not allowed because not listed in AllowUsers format: $1 dest: CATEGORY sshd: denied access by policy pattern: postfix\/local: ($pat{word}): to\=\<($pat{mail_address}|$pat{mail_user})\>\, (?:orig_to=<($pat{mail_address}|$pat{mail_user})?>, )?relay\=($pat{word})\, delay\=($pat{int})\, status\=sent \(($pat{anything})\) format: email: email delivered locally dest: CATEGORY statistics pattern: postfix\/local: ($pat{word}): to\=\<($pat{mail_address}|$pat{mail_user})\>\, (?:orig_to=<($pat{mail_address}|$pat{mail_user})?>, )?relay\=($pat{word})\, delay\=($pat{int})\, status\=bounced \(($pat{anything})\) format: $2 dest: email: email bounced pattern: dhcpd: if ($pat{host}) ($pat{word}) ($pat{word}) rrset doesn\'t exist ($pat{word}) ($pat{host}) ($pat{int}) ($pat{word}) ($pat{word}) ($pat{ip}): timed out\. format: $1 dest: CATEGORY dhcpd: rrset doesn't exist pattern: sshd: Did not receive identification string from ($pat{ip}) format: $1 dest: CATEGORY sshd: did not receive ident string from host pattern: named: zone ($pat{zone})\/default: refresh: retry limit for master ($pat{ip})\#($pat{port}) exceeded \(source ($pat{ip})\#($pat{port})\) format: $1 from $2 dest: CATEGORY named: retry limit for zone exceeded pattern: named: transfer of \'($pat{zone})\' from ($pat{ip})\#($pat{port}): failed to connect: timed out format: $1 from $2 dest: CATEGORY named: transfer failed pattern: sshd: error: Could not get shadow information for NOUSER dest: SKIP pattern: (postfix\/postfix\-script: fatal: usage: postfix start \(or stop\, reload\, abort\, flush\, check\, set\-permissions\, upgrade\-configuration\)) format: $1 dest: CATEGORY stuff that might need fixing pattern: postfix\/postfix\-script: refreshing the Postfix mail system dest: SKIP pattern: postfix\/master: reload configuration ($pat{file}) dest: SKIP pattern: postfix\/postfix\-script: starting the Postfix mail system dest: SKIP pattern: postfix\/master: daemon started \-\- version ([\d\.]+)\, configuration ($pat{file}) dest: SKIP pattern: postfix\/postfix\-script: stopping the Postfix mail system dest: SKIP pattern: postfix\/master: terminating on signal 15 dest: SKIP pattern: dhcpd: DHCPACK on ($pat{ip}) to ($pat{mac}) \(($pat{word})\) via ($pat{word}) dest: SKIP pattern: dhcpd: DHCPREQUEST for ($pat{ip}) from ($pat{mac}) \(($pat{word})\) via ($pat{word}) dest: SKIP pattern: (postfix)\/($pat{word}): warning: (dict_nis_init: NIS domain name not set \- NIS lookups disabled) format: $1: $3 dest: CATEGORY stuff that might need fixing pattern: postfix\/($pat{word}): warning: (database ($pat{file}) is older than source file ($pat{file})) format: postfix: $2 dest: CATEGORY stuff that might need fixing pattern: named: client ($pat{ip})\#($pat{port}): view ($pat{word}): query \(cache\) \'($pat{file})\' denied format: $1 dest: CATEGORY named: unapproved query pattern: named: zone ($pat{zone})\/default: Transfer started\. dest: SKIP pattern: named: transfer of \'($pat{zone})\' from ($pat{ip})\#($pat{port}): connected using ($pat{ip})\#($pat{port}) dest: SKIP pattern: named: client ($pat{ip})\#($pat{port}): view default: update \'($pat{zone})\' denied format: $1 for $3 dest: CATEGORY named: unapproved update from pattern: dhcpd: Wrote ($pat{int}) leases to leases file\. dest: SKIP pattern: dhcpd: Wrote ($pat{int}) new dynamic host decls to leases file\. dest: SKIP pattern: dhcpd: Wrote ($pat{int}) deleted host decls to leases file\. dest: SKIP pattern: postfix\/smtpd: ($pat{word}): client\=($pat{host})\[($pat{ip})\] dest: SKIP pattern: postfix\/qmgr: ($pat{word}): from\=\<($pat{mail_address})?\>\, size\=($pat{int})\, nrcpt\=($pat{int}) \(([^\)]+)\) dest: SKIP pattern: postfix\/smtp: ($pat{word}): host ($pat{host})\[($pat{ip})\] said: ($pat{anything}) format: $2 said $4 dest: CATEGORY email: host reported problem pattern: postfix\/smtp: ($pat{word}): to\=\<($pat{mail_address})?\>\, (?:orig_to=<($pat{mail_address}|($pat{mail_user}))?>, )?relay\=($pat{host})\[($pat{ip})\]\, delay\=($pat{int})\, status\=sent \(($pat{anything})\) format: email sent via smtp dest: CATEGORY statistics pattern: postfix\/smtp: ($pat{word}): to\=\<($pat{mail_address})?\>\, (?:orig_to=<($pat{mail_address}|($pat{mail_user}))?>, )?relay\=($pat{host})\[($pat{ip})\]\, delay\=($pat{int})\, status\=bounced \(($pat{anything})\) format: $2 dest: email: email bounced pattern: postfix\/smtp: ($pat{word}): to\=\<($pat{mail_address})?\>\, (?:orig_to=<($pat{mail_address}|($pat{mail_user}))?>, )?relay\=($pat{host})\[($pat{ip})\]\, delay\=($pat{int})\, status\=deferred \(($pat{anything})\) format: email deferred via smtp dest: CATEGORY statistics format: $2 dest: CATEGORY email address temporarily unreachable pattern: postfix\/smtpd: disconnect from ($pat{host})\[($pat{ip})\] dest: SKIP pattern: named: client ($pat{ip})\#($pat{port}): view default: transfer of \'($pat{zone})\/($pat{word})\': AXFR (started|ended) dest: SKIP pattern: postfix\/cleanup: ($pat{word}): message\-id\=\<([^\<\>]+)\> dest: SKIP pattern: postfix\/pickup: ($pat{word}): uid\=($pat{int}) from\=\<($pat{mail_user}|$pat{mail_address})\> dest: SKIP pattern: postfix\/qmgr: ($pat{word}): removed dest: SKIP pattern: postfix\/anvil: statistics: max cache size ($pat{int}) at ($pat{anything}) dest: SKIP pattern: postfix\/anvil: statistics: max connection count ($pat{int}) for \(($pat{word}):($pat{ip})\) at ($pat{anything}) dest: SKIP pattern: postfix\/anvil: statistics: max connection rate ($pat{int})\/($pat{int})s for \((smtp(?:\-local)?):($pat{ip})\) at ($pat{anything}) dest: SKIP # last message repeated. This one is pretty much unique. pattern: last message repeated (\d+) times? count: $1 dest: LAST category: scans filter: >= 5 category: wormsign filter: >= 10 @@endif # plain: log type for plain text files add arr log_type_list= plain add arr plain_filenames= set var plain_date_pattern=() set var plain_date_format= # null: special type for "processing" /dev/null or for throwing out files add arr log_type_list= null add arr null_filenames= null add arr null_pre_date_hook= @@ifndef __USE_MINIMAL_CONFIG next; @@endif set var null_date_pattern= set var null_date_format= @@ifndef __USE_MINIMAL_CONFIG logtype: null pattern: .* dest: SKIP @@endif # done describing log types. @@ifndef __USE_MINIMAL_CONFIG # some default actions. action: ssh command: ssh %h window: %h action: telnet command: telnet %h window: %h set var window_command=xterm -n "%t" -name "%t" -title "%t" -e %C # some login config set var default_login_action=ssh add arr login_action= @@endif # global variables set var other_host_message=Other hosts syslogging to us # pretty format for dates, in strftime(3) format set var date_format=%Y_%m_%d # output message for one-day mode (default), subject to usual tags, plus %d # stands for date set var output_message_one_day = Logs for %n on %d # same concept as above except for -a mode with no date range set var output_message_all_days= All logs for %n as of %d # same concept as the last two, except for -a mode with a date range. %s # for start date, %e for end date set var output_message_all_days_in_range= All logs for %n for %s through %e # command used to send mail. Subject to usual tag substitutions, plus # %m stands for mail_address and %o stands for the relevant output message. set var mail_command = Mail -s '%o' %m # command used to get the process' memory size @@ifos Linux set var memory_size_command=ps -p %p -o vsz | tail -n +2 @@endif @@ifos SunOS set var memory_size_command=ps -p %p -o vsz | tail +2 @@endif # Set PATH environment variable. set var PATH=/usr/local/bin:/bin:/usr/bin:/usr/ucb:/usr/X11R6/bin:/usr/openwin/bin # these variables are usually set by uname(2), but you can override them # if you really want to. #set var nodename=ook #set var osname=Linux #set var osrelease=2.2 # assorted variables that default to not being defined, but you can set # them if you want to. This group corresponds to command-line options. #set var show_all= #set var real_mode= #set var days_ago= #set var output_file= #set var mail_address= #set var process_all_nodenames= # patterns that can be used in other patterns. NB: this is obsolete. #set var file_pat=[\w\_\-\/\.]+ #set var host_pat=[\w\.\-]+ #set var ip_pat=[\d\.]+ #set var user_pat=[\w\_\-]+ #set var mail_user_pat=[\w\_\-\.\*\+\=]+ #set var word_pat=[\w\_\-]+ #set var zone_pat=[\w\.\-]+ # The new way to specify patterns that can be used in other patterns set arr pat= anything, .* file, [\w\_\-\/\.]+ host, [\w\.\-]+ int, \d+ ip, [\d\.]+ user, [\w\_\-]+ mail_user, [\w\_\-\.\*\+\=]+ mail_address, (?:[\w\_\-\.\*\+\=]+\@[\w\.\-]+) named_tag, (?:(?:$pat{file})?named) port, (?:\d{1,5}) word, [\w\_\-]+ zone, (?:[\w\.\-]+(?:/IN)?) sendmail_tag, (?:sendmail|sm-mta|sm-msp-queue) # # note: sendmail_queue_id includes the first continuation line sendmail_queue_id, (?:(?:NOQUEUE|[A-Za-z]{3}\d{5}|[0-9A-Za-z]{12}|[0-9A-Za-z]{8}\d{6})(?:\[1\])?) # # ssh_id currently is only ssh2, because I don't have anything else ssh_id, ssh2 mac, (?:(?:[0-9a-fA-F]{1,2}:){5}[0-9a-fA-F]{1,2}) hex, [[:xdigit:]] whitespace, \s+ logtype: syslog pattern: kernel: IN=($pat{word})? OUT=($pat{word})? MAC=($pat{mac}):($pat{mac}):([[:xdigit:]]{2}:[[:xdigit:]]{2}) SRC=($pat{ip}) DST=($pat{ip}) LEN=(\d+) TOS=0x([[:xdigit:]]{2}) PREC=0x([[:xdigit:]]{2}) TTL=(\d+) ID=(\d+) (DF )?PROTO=(\w+) SPT=(\d+) DPT=(\d+).* use_sprintf: delete_if_unique format: "%-15s => %-15s %-5s %-5s", $6, $7, $14, $16 dest: kernel: firewall deny format: $6, $7 dest: UNIQUE scans format: "$14 $16", $6 dest: UNIQUE wormsign pattern: kernel: IN=($pat{word})? OUT=($pat{word})? MAC=($pat{mac}):($pat{mac}):([[:xdigit:]]{2}:[[:xdigit:]]{2}) SRC=($pat{ip}) DST=($pat{ip}) LEN=(\d+) TOS=0x([[:xdigit:]]{2}) PREC=0x([[:xdigit:]]{2}) TTL=(\d+) ID=(\d+) (DF )?PROTO=(\w+) TYPE=(\d+) CODE=(\d+).* use_sprintf: format: "%-15s => %-15s %-5s %-5s", $6, $7, $14, $15 dest: kernel: firewall deny format: $6, $7 dest: UNIQUE scans set arr commands_to_run= @@ifndef __USE_MINIMAL_CONFIG w df -k [ -f /etc/dumpdates ] && cat /etc/dumpdates @@endif # log files that, if not present or not openable, will cause an error # 2000-08-27: morty: required_log_files plays havoc with some internal # stuff. I'm discontinuing support for it in the config file. # log files that we process if present. Note that these are globbed. add arr optional_log_files= @@ifndef __USE_MINIMAL_CONFIG /var/log/authlog* /var/log/daemon* /var/log/maillog* /var/adm/messages* /var/log/messages* /var/log/secure* /var/log/syslog* /var/log/wtmp* /var/adm/wtmpx* /var/adm/sulog* @@endif # rules for decompressing compressed files. set arr decompression_rules= gz, gzip -dc %f bz2, bzip2 -dc %f Z, compress -c %f # filename patterns to ignore when including directories set arr filename_ignore_patterns= .*\~ \..*\.swp \#.*\# # rules for PGPing stuff set arr pgp_rules= 2, pgp -afe %m 2>/dev/null 5, pgpe -afr %m 2>&1 g, gpg -aer %m 2>&1 # colors used for real mode add arr colors= bell, %a # normal, %e[0m bold, %e[1m intense, %e[2m italics, %e[3m underscore, %e[4m blink, %e[5m inverse, %e[7m # black, %e[30m red, %e[31m green, %e[32m yellow, %e[33m blue, %e[34m magenta, %e[35m cyan, %e[36m white, %e[37m # black_bg, %e[40m red_bg, %e[41m green_bg, %e[42m yellow_bg, %e[43m blue_bg, %e[44m magenta_bg, %e[45m cyan_bg, %e[46m white_bg, %e[47m # # umask, the usual meaning. set var umask=077 # priority, ie. "niceness". man nice for more info. # If you set it to 0, the program will not attempt to set priority. # Please don't set this to a negative number unless you *really* know # what you're doing. set var priority=0 # any categories listed in here won't appear in the output. Defaults to none, # but feel free to add to it in the local config file if you get too much # stuff you're not interested in. set arr ignore_categories= # the format string used for "real mode". %n is the nodename of the message, # %c is the category of the message, %# is the count, %d is the data, \\ is # backslash, \n is newline, \t is tab, %R is the raw log line minus newline set var real_mode_output_format=%c: (loghost %n, from host %h)\n%-10# %d\n\n # in "real mode", how many seconds should we sleep after we're done looking # at the log files, before we look for more input set var real_mode_sleep_interval=1 # in "real mode", every now and then we want to check if the log files have # rolled over or new log files have appeared. This is how often we do that. set var real_mode_check_interval=300 # the default format for actions to use when piping data. You can override # on a per-action basis with action_format. set var default_action_format=%c\n%#\t%d\n # throttles use a key to decide if they should throttle. Make the key # include the information that you want to suppress if it appears again. # You can override on a per-action basis with throttle_format. set var default_throttle_format=%c\n%d\n # the format to use for printing set var print_format=%c\n%#\t%d\n # the format to use for saveing set var save_format=%c\n%#\t%d\n # command to use for printing set var print_command=fmt -s|lpr # should GUI mode print all? set var gui_mode_print_all=0 # should GUI mode save all? set var gui_mode_save_all=0 # GUI mode file for saving events set var gui_mode_save_events_file= # should the GUI config be autosaved? set var gui_mode_config_autosave=0 # should the GUI config save everything, or only local changes set var gui_mode_config_savelocal=0 # should the GUI config do RCS before and after saving? set var gui_mode_config_save_does_rcs=1 # what is the config file for GUI mode named? Don't bother defining here, # because not checked until afterwards # set var gui_mode_config_file= # How do we run RCS? set var rcs_command=ci -q -l -t-%f -m'automatic check-in' %f # how should we sort? You can set this to "string" for a simple string # sort, "funky" for a sort that understands IP address and other strings # with embedded integer values, or "numeric" for a simple numeric sort # (don't use unless you are really dealing with only numeric data) set var default_sort=funky # categories that will appear before anything else in the output. set arr priority_categories= @@ifndef __USE_MINIMAL_CONFIG major events stuff that might need fixing @@endif # includes # assorted standard includes. include_if_exists continues if the file # doesn't exist; include dies nastily if the file doesn't exist. # include_dir includes all the files in the directory, dying if the # directory doesn't exist or if a file can't be opened; include_dir_if_exists # includes all the files in the directory, not dying if the directory # doesn't exist, but dying if a file in the directory can't be opened. # This clump is put here last so that local configs will override the default. @@ifndef __NO_STD_INCLUDES include_dir_if_exists @prefix@/etc/log_analysis.d include_if_exists @prefix@/etc/log_analysis.conf include_if_exists @prefix@/etc/log_analysis.conf-%s include_if_exists @prefix@/etc/log_analysis.conf-%s-%r include_if_exists @prefix@/etc/log_analysis.conf-%n include_dir_if_exists /etc/log_analysis.d include_if_exists /etc/log_analysis.conf include_if_exists /etc/log_analysis.conf-%s include_if_exists /etc/log_analysis.conf-%s-%r include_if_exists /etc/log_analysis.conf-%n @@endif # The internal implementation for reading the ~/.log_analysis.conf config # is to set _CONFIG_FILE1 to the file. # the internal implementation of the -f option is to set _CONFIG_FILE2 to # -f's argument. @@ifdef _CONFIG_FILE1 include @@{_CONFIG_FILE1} @@endif @@ifdef _CONFIG_FILE2 include @@{_CONFIG_FILE2} @@endif # the @@end preprocessor directive can be used to stop processing the # config file. But you don't need it. @@end =head1 NAME log_analysis - Analyze various system logs =head1 SYNOPSIS B [B<-h>] [B<-r>] [B<-g>] [B<-f> config_file] [B<-o> file] [B<-O>] [B<-n> nodename] [B<-U>] [B<-u> unknownsdir] [B<-D> var1,var2=value,...] [B<-d> days_ago] [B<-a>] [B<-F>] [B<-i>] [B<-m> mail_address] [B<-M> mail_prog] [B<-s>] [B<-S>] [B<-t> forced_type] [required_files. . .] B B<-I info_type> =head1 DESCRIPTION I analyzes and summarizes system logs files. It also runs some other commands (ie. I, I) to show the system state. It's intended to be run on a daily basis out of cron. I supports several major modes. The default mode is report mode, which scans through your logs, produces a text report, and exits. There is also real mode, which lets you monitor your logs continuously; gui mode, which is a gui sitting on top of real mode; and daemon mode, which is a daemonized variant of real mode. =head1 OPTIONS =over 4 =item B<-a> all Show all logs, not just the ones from yesterday. =item B<-A> daemon mode Start in daemon mode. Daemon mode is like real mode, except that the process daemonizes, and there is no regular output, just actions. daemon mode is useful if you want to start I at system boot time to run actions. It's also useful if you have actions configured, and you have multiple copies of log_analysis running in real/gui mode, and you only want the actions to happen once. See I<-r> for more info on real mode. In general, anything that applies to real mode applies to daemon mode unless it explicitly says otherwise. The variables specific to daemon mode are I and I. One variable that is not specific to daemon mode but is really useful with daemon mode is I. =item B<-b> real mode backlogs By default, real mode and gui mode ignore all existing log messages and only show new logs. With this option, real mode shows logs as indicated by I. See I<-r> for more info. =item B<-d days_ago> Show logs from I days ago. Defaults to 1 (ie. show yesterday's logs.) In I<-a> mode, this option only affects the heading, and it defaults to 0. You can also provide an absolute date in the form YYYY_MM_DD, ie. 2001_03_02. And you can provide the symbolic names I (equivalent to 0) and I (equivalent to 1). And you can even provide a date range in the form YYYY_MM_DD-YYYY_MM_DD or ago1-ago2 to get output for a range of days. Each day is output individually, so if you use the I<-o> option, you get a separate file for each day, and if you use the I<-m> option, you get a separate mail for each day. You can also set this in the config with the I variable. See I<-r> for how days_ago is handled under real mode and gui mode. =item B<-D var1,var2=value,var3,...> This option lets you define preprocessor constants. Its argument is a comma-separated list of constants to define. To set a constant to a particular value, say "constant=value". =item B<-f config_file> Read I in addition to the internal config and the internal config files. See L<"CONFIG FILE"> for details. =item B<-F> Instead of loading the whole internal config, just use a minimal subset. =item B<-g> "gui mode", ie. monitor log files continuously. Currently conflicts with many other modes and options. Yes, has built-in support for log file rollover. This is basically real mode (see I<-r>) with a GUI; variables that apply to real mode also apply to gui mode, but not vice versa. See variables I, I, and I for gui mode specifics. See B<-r> for many things that also apply to gui mode. =item B<-h> help Show command summary and exit. =item B<-i> includes suppress Don't include the standard include files, ie. /etc/log_analysis.conf, @prefix@/etc/log_analysis.conf, and the others listed in L<"FILES">. Note that this option does not stop the inclusion of $HOME/.log_analysis.conf in gui mode. =item B<-I info> This option is used for obtaining internal information about I. I exits immediately after outputting the information. If I is I, I outputs the list of things you can use for I. If I is I, all categories (those mentioned in the various configs and implicit categories) will be listed. If I is I, all colors that work for real_mode and gui_mode will be listed. If I is I, all config files will be listed with their config_version and file_version (if defined). If I is I, the evals built from the config (internal and local) are output. If I is I, the internal config is output. If I is I, the log files that would have been read are output. If I is I, the known log types are output. If I is I, I just exits. Useful for testing configs. If I is I, the known subpatterns will be listed. If I is I, the various patterns defined for the log types are output. =item B<-m mail_address> Mail output to I. This can also be specified in the config; see B in L<"VARIABLES">. =item B<-M mail_command> Use I to send the mail. This can also be specified in the config; see B in L<"VARIABLES"> for more info, including the default. =item B<-n nodename> Use I as the nodename (AKA hostname) instead of the default. This is more than just cosmetic: entries in syslogged files will be processed differently if they didn't come from this nodename. This can also be specified in the config file; see B in L<"VARIABLES">. =item B<-N> process all nodenames If the logs contain entries for nodes other than I, (ie. if the host is a syslog server), analyze them anyway. =item B<-o file> Output to I instead of to standard output. Works with I<-m>, so you can save to a file and send mail with one command. =item B<-O> With I<-o file>, causes the output to go both to the file and to standard output. NB: this does not currently work with I<-m>, so you can't output to a file, standard output, and to email. =item B<-p pgp_type> Encrypts the mail output. Uses pgp_type to determine the encryption command. For use with B<-m> or B. See B in the list of global variables for info on encryption types. =item B<-r> "Real mode", ie. monitor log files continuously. Currently conflicts with many other modes and options. Yes, has built-in support for log file rollover. See I<-g> for a GUI that can sit on top of this mode, and I<-A> to run real mode as a daemon. See variables I, I, I, I, I (or the I<-b> option), and I in the list of global variables for more configurables. I in real mode and gui mode, only the most recent file per glob in I is monitored. This means that you should set it to something like I and I rather than I. I in real mode and in gui mode, I treats I differently; if it's a simple number, it is treated as the number of days ago to start looking at logs. So, if days_ago is 7, I looks through the past 7 days' worth of logs. HOWEVER, even if B<-d> is set, I doesn't actually show these logs unless I<-b> is specified or the corresponding variable real_mode_backlogs is set. I The primary feature of I is its reporting capability. Using it for continuous monitoring makes sense if you want a single config for reporting and for continuous monitoring. If you just want continuous monitoring then you may be better off with some of the other software out there, such as L. =item B<-s> suppress other commands Usually, I runs assorted commands that show system state (ie. I, I). This option doesn't run those commands. See B in L<"VARIABLES"> for the list of extra commands. The B variable does the same thing as this option. =item B<-S> suppress output footer Usually, I will include its version number, the time it spent running, and its arguments at the end of the output. This option suppresses that output. The B variable does the same thing as this option. =item B<-t forced_type> I usually determines the type of logfiles by looking at the per-type I extension. This option and the I variable let you bypass that check. =item B<-U> unknowns-only Output logfile unknowns to stdout and exit. If I exists, also wipe I if it exists and then write out raw unknown lines to files in I. This exists to make writing custom rules easier. =item B<-u unknownsdir> Use I as the unknownsdir. If I already exists, and contains files, its files will be used as the input for I regardless of any other command line options. If I<-U> is also specified, after all processing I will be wiped out and its files rewritten with the current unknowns. This is useful for writing your own configs. =item B<-v> version Output version and exit. =item B If files are specified on the command line, log_analysis ignores its built-in list of optional and required log files, and process the files on the command line. If one of the files doesn't exist, it's a fatal error. =back =head1 CONFIG FILE The script has an embedded config file. It will also read various external config files if they exist; see L<"FILES"> for a list. Later directives (from later in the file or from a file read later) override earlier directives. You can make comments with '#' at the beginning of a line. If you want a '#' or '=' at the beginning of a line, you usually need to quote it with backslash. Some directives take a "block" as argument. A block is a collection of lines that ends with a line that is empty or only contains whitespace. '#' at the beginning of a line still comments out the line. Leading whitespace on a line is ignored. Before the config is parsed, it is passed through a preprocessor inspired by the L preprocessor. =over 4 =head2 Pattern directives These directives describe your logs, and are the main point of this program. The basic idea here is that you first declare what logtype you are working with, and then you specify a bunch of perl patterns that describe different kinds of log messages, and that save parts of the message. For each perl pattern, you specify one or more destinations that describe what you want done with it. =item B I Future patterns should be applied to this logtype (ie. sulog, syslog, wtmp.) Example: I =item B I I is a perl regex (see L) that implictly starts with ^ (beginning of the line) and implicitly ends with \s*$ (optional whitespace and the end of the line.) This should only be issued after a B has been issued in the same config file. Wildcard parts of the pattern should be surrounded with parentheses, to save these parts for later use in the B. Note that there are some tokens with special meanings that can be used here in the format $pat{something}, ie. $pat{ip}, $pat{file}, etc. (see L<"pat"> for details, and run I for the current list). Examples: I I The order of precedence for patterns is undefined, except that user-defined patterns always have precedence over the patterns of the internal config. =item B I I is treated as a string that contains the useful information from a pattern. Note that it should not actually be quoted. A format is mandatory for category destinations, but should not be used with SKIP or LAST destinations. For example, if we had a pattern that was I, we would probably just want $2, so we might say: I Similarly, if we had a patterns that was I, we might want to say: I $3> =item B I is optional. If this directive is present for a given format, than instead of the format being treated as a string, it is treated as the arguments for L. For example, if you have a source IP address in $2 and a destination IP address in $3, you could just have dest as I<$2 =E $3>, but you would have things lining up better if you did this: I $3", $2> I =item B I is optional. This feature can be used when you have multiple Is for one pattern, one of which is a regular category and one of which is a I with a filter. You want the one that is a regular category to be deleted if the I category meets its filter, ie. because it's a scan. See L<"UNIQUE DESTINATION"> for more info. =item B I I is optional. The default is that a log line that matches a pattern causes the category to increment by 1. But sometimes, a single log line corresponds to multiple events, ie. if you have a log message of the form "5 packets denied by firewall" or "last message repeated 3 times", you can extract the event count to I. For example, if you're using the pattern I, you might say: I =item B I space-separated list of colors to display this message in when in real-mode or gui-mode. For a list of colors that will work in both modes, run I. Note that "bell" is among the available colors, because it didn't fit anywhere else. See the I entry for more info. NOTE: if multiple dest configs with conflicting color settings result in delivery to the same line in gui mode, the result is currently undefined. There is only one line to be displayed, after all. =item B I This is a simple text description of the event, to explain the problem to your operators. It can be accessed via gui mode. The note above by color applies. =item B I Run "action" (described elsewhere in the config with the "action:" keyword) if this event is seen in real mode or gui mode. =item B I Assign priority I to action. Currently, the only priority that does anything is "IGNORE". It can be used to ignore events. =item B I This describes what you want done with the data in a pattern. If I is the special token I the data is discarded. If I is the special token I, the data is assumed to be of the form "last message repeated N times", and we pretend as though the last message we saw occurred, using I as a multiplier. If I starts with the special token I, we do special "unique" handling, which is covered in L<"UNIQUE DESTINATION">. If I starts with the special token I or is any other string, it is treated as a category that the pattern data should be saved to. Ie. if I was I, and I was I<$2>, then one might set I to I. You must have a format defined before the I. You can have multiple I directives for a single I, if all of the Is are category destinations. Each one needs its own I. Similarly, if you set I or I, they are tied to the particular I you set them with. Note that I "closes" the description of a destination, so you need to have any other related directives (ie. I, I, I, I) before the I directive. This ordering is necessary to avoid ambiguity in the multiple-destination case. =back =head2 Event directives You can configure what happens for incoming events based on certain criteria. Currently, those criteria are a simple string match of one or more of the category, data, or hostname. So, for example, you can ignore all messages from "roguehost", or color "user logged in" messages for a certain user in bright red. Here are the useful directives: =over 4 =item B Starts a new event config. =item B I I =item B I I =item B I I This event config applies when the "category" is "value", or the "data" is value, or the "hostname" is "value". If multiple match lines are supplied, they are ANDed together. =item B I =item B I =item B I =item B I color, description, do_action, and priority work the same way as they do in a "dest" config or in an "event" config. If "event", "dest", and "category" configs all apply to a given event than "event" has highest precedence, followed by "dest", followed by "category". =back =head2 Category directives Several patterns can lead to the same category, so category-specific directives are associated with the category, not with a pattern. Here are the category directives: =over 4 =item B I Specifies which category subsequent directives will define. =item B I By default, I will output all the data it finds in a category. Filters let you specify, say, that only the top 10 items should be output, or that only the items that occurred fewer than 5 times should be output. If a category has data, but none of the data meet the filter rules, then the category will be completely skipped. See L<"FILTERS"> for more info. =item B I Specifies how this category should be sorted in the output. Examples are "funky", "string", "value", "reverse value", etc. The default is "funky". See L<"SORTING"> for more info. =item B I The usual way to populate categories is via the pattern config. But sometimes, you want to combine two or more elemental categories to make a new category. Any categories derived in this manner may not be a destination for simple patterns. There are currently three subcommands for this (the quotes are literal): =over 8 =item I<"category1"> B I<"category2"> =item I<"category1"> B I<"category2"> These do what you expect: take the values for the items in category2 and add or subtract them from the values for the items in category1. Any item defined in either category will be in the new category. Subtract can cause the values in the new category to be negative or 0. =item I<"category1"> B I<"category2"> The new category will contain items in category1 that are not in category2. This is very different from subtract. Example: if category1 contains A with a value of 2 and B with a value of 2, while category2 contains A with a value of 1 and C with a value of 1, '"category1" subtract "category2"' will contain A with a value of 1, B with a value of 2, and C with a value of -1, while '"category1" remove "category2"' will only contain B with a value of 2. =back =item B I =item B I =item B I =item B I color, description, do_action, and priority work the same way as they do in a "dest" config or in an "event" config. If "event", "dest", and "category" configs all apply to a given event than "event" has highest precedence, followed by "dest", followed by "category". =back =head2 Action directives In real mode and in gui mode, sometimes you want an "action" (like paging someone) to automatically happen when a particular message is seen. And in gui mode, you might want to run a command on a message interactively (ie. to telnet or ssh into the host it came from.) The directives to do that (inspired by L) are: =over 4 =item B I Starts defining a new action named action_name. =item B I The command to run for the current action. I uses the same tags as I. WARNING: you can potentially shoot yourself in the foot by passing data that has not been sanitized to a command on your system. Be careful! =item B I Performing the action will require creating a window using I<title> as the title. The title will be passed to I<window_command> as the "%t" tag. I<title> itself uses the same tags as I<real_mode_output_format>. This only makes sense for gui mode. WARNING: you can potentially shoot yourself in the foot by passing data that has not been sanitized to a command on your system. Be careful! =item B<use_pipe:> The data in the event will be sent to the command via standard input. The format used will be that specified by the I<default_action_format> variable, unless overridden locally by the I<action_format:> directive. These formats allow the same tags as I<real_mode_output_format>. =item B<action_format:> I<format> See I<use_pipe> above. =item B<throttle:> I<throttle_time> Automatically-triggered actions can potentially result in a slew of events. The "throttle" option lets you specify a minimum amount of time before the action should recur with this event. The time can be specified as seconds, as minutes:seconds, or as hours:minutes:seconds. Throttles do not apply to actions and logins that are explicitly invoked via the GUI. By default, the throttle is triggered on unique category and data. That is, if the event was category "user logged in" and the data was "morty", then the throttle will keep "user logged in", "morty" events from causing the action to run again, but won't stop "user logged in", "esther" or "no such user", "morty" events from triggering the action. This default is set with the I<default_throttle_format> variable, which defaults to "%c\n%d". It can be overriden on a per-action basis with the I<throttle_format:> directive, which takes the same tags as I<real_mode_output_format>. If you want the throttle to be global to the action (say, a pager action), set throttle_format to a simple scalar value (like 1). =item B<throttle_format:> I<format> See I<throttle:> above. =back =head2 Other directives =over 4 =item B<config_version> I<version-number> Declare that the config is compatible with version I<version-number>. This is for version-control purposes. Every config file should have one of these. You can scan your config files' config versions with I<-I config_versions>. =item B<file_version> I<revision-information> Your own version control information. I<revision-information> can be arbitrary text. You can scan your config files' config versions with I<-I config_versions>. =item B<include> I<file> Read in configuration from I<file>. Dies if I<file> doesn't exist. I<file> is subject to usual tag substitutions; see L<"TAG SUBSTITUTION">. =item B<include_if_exists> I<file> Just like B<include>, but doesn't die if the file doesn't exist. =item B<include_dir> I<dir> Read in all files in I<dir>, and include them. Die if the directory doesn't exist, or if a file in the directory isn't readable. I<dir> is subject to the usual tag substitutions; see L<"TAG SUBSTITUTION">. Any filenames that match a pattern in I<filename_ignore_patterns> will be skipped. =item B<include_dir_if_exists> I<dir> Just like B<include_dir>, but doesn't die if the directory doesn't exist. I<Does> still die if any of the files in I<dir> isn't readable. =item B<block_comment> Throws out the block immediately after it. =item B<set var> I<varname> =I<value> Set scalar variable I<varname> to value I<value>. If the variable already exists, this will overwrite it. See L<"VARIABLES"> for the list of variables you can play with. =item B<add var> I<varname> =I<value> If scalar variable B<varname> already exists, append I<value> to the end of its current value. If it doesn't yet exist, create it and set it to I<value>. See L<"VARIABLES"> for the list of variables you can play with. =item B<prepend var> I<varname> =I<value> If scalar variable B<varname> already exists, prepend I<value> to the current value. If it doesn't yet exist, create it and set it to I<value>. See L<"VARIABLES"> for the list of variables you can play with. =item B<set arr> I<arrname> = Read in the block that follows this declaration, make the lines into an array, and set the array variable I<arrname> to that array. See L<"VARIABLES"> for the list of variables you can play with. =item B<add arr> I<arrname> = Read in the block that follows this declaration, make the lines into an array, and append that array to the array named I<arrname>. See L<"VARIABLES"> for the list of variables you can play with. =item B<prepend arr> I<arrname> = Read in the block that follows this declaration, make the lines into an array, and prepend that array to the array named I<arrname>. See L<"VARIABLES"> for the list of variables you can play with. =item B<remove arr> I<arrname> = Read in the block that follows this declaration, and for each line, look for and delete that line from array I<arrname>. If one of these lines cannot be found, the result is a warning, not death. See L<"VARIABLES"> for the list of variables you can play with. =item B<local> OTHER DIRECTIVE Putting "local" in front of another directive means that this directive should be saved when gui_mode_config_savelocal is in effect. =item B<nowarn> OTHER DIRECTIVE Putting "nowarn" in front of another directive means that this directive should not generate a config warning, i.e. for redefining a category filter. =back =head1 VARIABLES Some variables are scalar, which means they are strings or numbers. Some variables are arrays, which are lists of scalars. Some variables are mandatory, which means they must be defined somewhere in one of the config files, while some variables are optional. Some variables are global, while some are per-log-type extensions. Some example of per-log-type extensions are date_pattern and filenames. Extensions should actually appear in the format "TYPE_EXTENSION", ie. date_pattern would actually appear as I<syslog_date_pattern> for the syslog log-type and I<sulog_date_pattern> for sulog. To see examples of many of the possibilities, as well as the default values, run I<log_analysis -I internal_config>. =head2 PER-LOG-TYPE VARIABLE EXTENSIONS =over 4 =item B<filenames> This mandatory extension is an array of file basenames that apply to the log type. For example, if you wanted I</var/adm/messages.1> to be processed by the syslog rules, you might add I<messages> to I<syslog_filenames>. =item B<open_command> Some log files (ie. wtmp log types) are in a binary format that needs to be interpreted by external commands. This optional scalar extension specifies a command to be run to interpret the file. The command is subject to the usual tag substitutions (see L<"TAG SUBSTITUTIONS">), plus the %f tag maps to the file. For example, the wtmp log type defines I<wtmp_open_command> as "I<last -f %f>". If both I<decompression_rules> and I<open_command> apply to a given file, the intermediate data will be stored in a temp file unless I<pipe_decompress_to_open> is used. See L<"pipe_decompress_to_open"> for more info. =item B<pipe_decompress_to_open> If both I<decompression_rules> and I<open_command> apply to a given file, the intermediate data will be stored in a temporary file by default to avoid problems with some commands that can't handle input from a pipe. If this optional scalar extension is set to I<1> (or any "true") value, then instead, the output of the decompression rule will be piped to the open command, and the open command's %f tag will be mapped to "-". =item B<open_command_is_continuous> If an I<open_command> has been specified and the command is the sort that never exits (ie. tcpdump or the like) you should set this to let log_analysis know what to expext. Such commands should only ever be used in real mode or gui mode. =item B<pre_date_hook> This optional extension is an array of arbitrary perl commands that are run for each log line, before the date processing (or any other processing) is done. =item B<date_pattern> This mandatory extension is a scalar that contains a pattern with at least one parenthesized subpattern. Before any rules are applied to a log line, the engine strips off the date pattern. If the engine is only looking at one day (ie. the default), it takes the part of the string that matched the parenthesized subpattern, and if it isn't equal to the right date, it skips the line. The B<date_format> extension (next) describes what the date should look like. =item B<date_format> This mandatory extension is a scalar that describes the date using the same format as B<strftime(3)>. For example, syslog_date_format is "%b %e". =item B<nodename_pattern> This optional extension is a pattern with at least one parenthesized subpattern. If it exists, then after the I<date_pattern> is stripped from the line, this pattern is stripped, and the part that matched the subpattern is compared to the nodename. If they're not equal, then the relevant counter for the category named by the I<other_host_message> variable is incremented. Note that all nodenames are subject to having the local domain stripped from them; see I<domain> and I<leave_FQDNs_alone> for details. =item B<pre_skip_list_hook> This optional extension is an array of perl commands to be run after the nodename check, just before the skip_list check. =item B<skip_list> This optional extension is obsolete and deprecated, but still works for backwards compatibility. =item B<raw_rules> This optional extension is obsolete and deprecated, but still works for backwards compatibility. =back =head2 GLOBAL VARIABLES These variables are all globals. =over 4 =item B<log_type_list> This variable is a mandatory global array that contains the list of all known log-types, ie. I<syslog>, I<sulog>, I<wtmpx>, etc. =item B<pat> This variable is a madatory global array that contains a list of subpattern names followed by a comma, optional whitespace, and a perl regex that represents that subpattern. Some of the predefined patterns include "ip", "zone", "user", "mail_user", etc. Run I<log_analysis -I pats> for a list. =item B<host_pat> =item B<file_pat> =item B<ip_pat> =item B<mail_user_pat> =item B<user_pat> =item B<word_pat> =item B<zone_pat> Legacy variables. Please don't use them. =item B<other_host_message> =item B<output_message_one_day> =item B<output_message_all_days> =item B<output_message_all_days_in_range> Assorted mandatory scalars that are used for human-readable output. B<other_host_message> defaults to "Other hosts syslogging to us", B<output_message_one_day> defaults to "Logs for %n on %d", B<output_message_all_days> defaults to "All logs for %n as of %d". B<output_message_all_days_in_range> defaults to "All logs for %n for %s through %e". =item B<date_format> This variable is a mandatory global scalar that describes how you want the date printed in the output. Uses the format of B<strftime(3)>. Note that you probably shouldn't use characters that you wouldn't want in a filename (ie. whitespace or '/') if you want to use the %d tag for I<output_file>. =item B<output_file> Equivalent to I<-o file>. This variable is an optional global scalar that lists a filename that will be output to instead of to standard output. Works with I<mail_address> (if specified.) Note that this variable is subject to the usual tag substitutions (see L<"TAG SUBSTITUTIONS">, plus you can use the %d tag for the date, so you can set it to something like "/var/log_analysis/archive/%n-%d". See I<output_file_and_stdout>. =item B<output_file_and_stdout> Equivalent to I<-O>. This variable is an optional global scalar that changes the behavior of I<-o> or I<output_file>. By default, I<-o> or I<output_file> causes output to only to only go to the named file. With this variable, output also goes to standard output. Note: this does not currently work with I<-m>. =item B<nodename> This variable is an optional global scalar that is used in a bunch of places: in checking to see whether a message from syslog (or other log type that defines I<nodename_pattern>) originated on this host; in reading in various default config files; etc. If left unset in the config, its value is set from the output uname(2). Its value is used to set the I<n> tag. Note that unless I<leave_FQDNs_alone> is set, I<log_analysis> will try to strip the local domain name from I<nodename>. =item B<osname> =item B<osrelease> These two optional global scalars default to the equivalent of I<uname -s> and I<uname -r>, respectively. They are only used for reading in default config files. Their values set the I<s> and I<r> tags, respectively. =item B<domain> This variable is an optional global scalar. If you don't set it, I<log_analysis> will try to set it by looking for a I<domain> line in I</etc/resolv.conf>. If I<log_analysis> has I<domain> set, it will attempt to strip away the local domain name from all nodenames it encounters, unless I<leave_FQDNs_alone> is set. See I<leave_FQDNs_alone> for details. =item B<leave_FQDNs_alone> This variable is an optional global scalar. By default, if I<log_analysis> has I<domain> set (either explicitly or implicitly), it will attempt to strip away the domain name in I<domain>, or "localdomain", from all nodenames it encounters. If you set this to I<1>, or to some other true value, I<log_analysis> will not attempt to strip the domain name in I<domain>. =item B<PATH> This variable is an optional global scalar that sets the I<PATH> environment variable. This doesn't help the initial setting of I<nodename>, I<osname>, or I<osrelease>, which are set from uname(2). =item B<umask> This variable is an optional global scalar that sets the umask. See L<umask(2)>. =item B<priority> This variable is an optional global scalar that sets the priority, or "niceness." See L<nice(1)>. Setting this to zero means run unchanged from the current niceness. Setting this negative is a bad idea unless you really know what you're doing, and is forbdidden to non-root users. =item B<decompression_rules> This variable is an optional global array of rules to decompress compressed files, in the format: compression-extension, comma, space, command to decompress to stdout. The command is subject to the usual tag substitutions (see L<"TAG SUBSTITUTIONS">, plus %f stands for the filename. For example, the rule for gzipped files is: C<gz, gzip -dc %f> The default rules support: .gz .Z .bz2 If both I<decompression_rules> and I<open_command> apply to a given file, the default is to use a temp file for the intermediate results unless I<pipe_decompress_to_open> is used. See L<"pipe_decompress_to_open"> for more info. =item B<pgp_rules> This variable is an optional global array of rules for PGP encrypting messages, in the format: PGP type (user defined), comma, space, command to PGP encrypt stdin to stdout. The command is subject to the usual tag substitutions, plus %m stands for the email address. For use with the "B<-p>" and "B<-m>" options. For example, the rule for gnupg is: C<g, gpg -aer %m 2E<gt>&1> Internally defined rules are "g" for "gnupg", "2" for PGP 2.x, and "5" for PGP 5.x. B<WARNING>: The user who runs log_analysis must have already imported the mail destination's key for this to work. Make sure to test this before you put it in a cronjob. =item B<filename_ignore_patterns> This variable is an optional global array of patterns that describe filenames to be skipped in an include_dir/include_dir_if_exists context, such as emacs backup file (".*~") or vim backup files ("\..*\.swp"). Only the file component of the path is examined, not the directory component. Patterns implicitly begin with ^ and implicitly end with $. =item B<mail_address> This variable is an optional global scalar that can consist of an email address. If set, the output of the script will be mailed to the address it is set to. The B<-m> option does the same thing, and overrides this. =item B<mail_command> This variable is an optional global scalar that is the command used to send mail if B<-m> is user or B<mail_address> is set. The B<-M> option does the same thing, and overrides this. This variable is subject to the usual tag substitutions, plus %m stands for mail_address and %o stands for the relevant output message. The default is: C<Mail -s '%o' %m> =item B<memory_size_command> This variable is an optional global scalar that is the command used to determine the process' memory size. Subject to the usual tag substitutions, plus %p stands for the PID (process ID) in question. If set, the command is run at the end of the report, and the output is included in the footer. The default value for Linux is: C<ps -p %p -o vsz | tail -n +2> The default value for Solaris/SunOS is: C<ps -p %p -o vsz | tail -n +2> =item B<optional_log_files> This variable is an optional array of file globs that are to be processed. Note that, unlike I<required_log_files>, these are globs rather than literal filenames, although literal filenames will also work. [Globs are filenames with wildcards, ie. I</var/adm/messages*>.] See I<-r> for an issue specific to real mode and gui mode. =item B<commands_to_run> This variable is an optional array of commands that are also supposed to be run to give a snapshot of the system state. These are currently: I<w>, I<df -k>, and I<cat /etc/dumpdates>. =item B<rcs_command> This variable is an optional global scalar that is the command used to do RCS check-in on files (i.e. when gui_mode_config_save_does_rcs is set). This variable is subject to the usual tag substitutions, plus %f stands for the file in question. The default is intended for RCS, although SCCS, CVS, SVN, or other systems could be substituted. The default is: C<ci -q -l -t-%f -m'automatic check-in' %f> =item B<suppress_commands> If set, the commands in B<commands_to_run> are NOT run during report mode. This is equivalent to the B<-s> option. =item B<suppress_footer> If set, the various report mode footers are not displayed. This is equivalent to the B<-S> option. =item B<ignore_categories> This variable is an optional array of categories that you don't want to see. Rather than try to remove all the rules for these categories, you can just list them here. =item B<priority_categories> This variable is an optional array of categories that will be listed first in the output. =item B<days_ago> This optional scalar variable is the config equivalent of the B<-d> option. =item B<process_all_nodenames> This optional scalar variable is the config equivalent of the B<-N> option. =item B<type_force> This optional scalar is the config equivalent of the B<-t> option. =item B<allow_nodenames> This variable is an optional array of nodenames that can log to this host. Usually, logs labelled as being from another host will not be anaylzed, and each such line will be listed in a special category; if you chose to allow some nodenames (or if you choose to process all nodenames by setting B<-N> or setting I<process_all_nodenames>) then these log messages will also be processed. =item B<real_mode> This variable is the config equivalent of the B<-r> option; see the B<-r> option for more details. =item B<real_mode_output_format> This is a required global scalar. It describes the per-output format for real mode and gui mode. It is subject to normal tag substitution (see L<"TAG SUBSTITUTION">); in addition to the normal tags, "%c" is replaced with the category, "%#" is replaced with the count, "%d" is replaced with the formatted data, "%h" is replaced with the nodename of the message, and "%R" is the raw, original log line without the trailing newline. If I<keep_all_log_lines> is set, you also get "%A" for all the raw logs line. I<WARNING:> you usually want "%h" (nodename of the message), not "%n" (nodename of the host you're running on, which is one of the default tags substitutions.) Defaults to "%c: (loghost %n, from host %h)\n%-10# %d\n\n". =item B<real_mode_sleep_interval> This optional global scalar is for use with real mode and gui mode. In these modes, I<log_analysis> reads log files for more data, sleeps for a little while, and then reads again. The sleep interval controls how long I<log_analysis> sleeps (in seconds). It defaults to 1. =item B<real_mode_check_interval> This optional global scalar is for use with real mode and gui mode. In these modes, I<log_analysis> sits in a loop reading from the logs files. Periodically, it wants to check if the log files have rolled over or if newer log files have appeared. If at least this long (in seconds) goes by since the last time we've checked, we check again. =item B<keep_all_raw_logs> This optional global scalar is a boolean for use with real mode and gui mode. It enables a %A tag that contains all the raw logs for a given entry. That is, if you have multiple log lines that contain essentially the same data, only the first line shows up in %R, and the rest are thrown out. This variable lets you keep them all. It can eat up a lot of memory, so it's disabled by default. =item B<real_mode_backlogs> This optional global scalar is equivalent to I<-b>. =item B<colors> This variable is an optional global array for use with real mode and gui mode. It defines the colors available on console, using "name, string" pairs. The usual tag substitution rules apply to the string, plus the special tag %a stands for octal character 007 (ASCII BEL) and %e stands for octal character 033 (ASCII ESC). Some of the colors are actually mode changes (ie. "normal", "inverse", "reverse", "blink", etc.) If you define any colors, you should also define a "normal" color. Note that "bell" is among the colors; it didn't belong anywhere else. You can list colors with I<log_analysis -I colors>. =item B<gui_mode> This variable is the config equivalent of the B<-g> option; see the B<-g> option for more details. It is an optional scalar. =item B<gui_mode_modifier> In gui mode, the default modifier to do things with the keyboard is "alt", ie. "alt-q" to exit. This lets you change it. It is an optional scalar. =item B<report_mode_output_node_per_category> =item B<report_mode_combine_nodes> =item B<report_mode_combine_shows_nodes> =item B<report_mode_combine_is_partway> These are assorted options for dealing with output for multiple node situations (ie. logservers.) They are all optional scalars. See L<"LOGSERVER CONSIDERATIONS"> for details. =item B<window_command> In gui mode, if we need a window to run a command, say an action, this will be the command that is used. The tags are the same as I<real_mode_output_format>, plus we have "%t" as the title and "%C" as the command. It is an optional scalar. =item B<login_action> This optional array lets you specify what action should be used to login to a given host in gui mode, overriding I<default_login_action>. Lines are in the format I<host, login_action>. =item B<default_login_action> This optional scalar specifies which login action should be used to login in hosts by default in gui mode. =item B<default_throttle_format> See the I<throttle:> directive in the I<action> group. =item B<default_action_format> See the I<use_pipe> directive in the I<action> group. =item B<print_command> =item B<print_format> =item B<save_format> =item B<gui_mode_config_autosave> =item B<gui_mode_config_savelocal> =item B<gui_mode_config_save_does_rcs> =item B<gui_mode_config_file> =item B<gui_mode_print_all> =item B<gui_mode_save_all> =item B<gui_mode_save_events_file> These are for GUI use. =item B<default_sort> This variable is an optional global scalar that describes how certain things will be sorted. See L<"SORTING"> for info on what this can be set to. Defaults to I<funky>. =item B<default_filter> This variable is an optional global scalar that describes the default category filter. See L<"FILTERS"> for info on what this can be set to. =back =head1 PREPROCESSOR DIRECTIVES NB: these get completely processed before all other directives, so they don't care about other syntax elements. Except as noted, these should appear at the beginning of the line after optional whitespace. =over 4 =item B<@@end> End of config file. =item B<@@define> I<var> I<val> Define I<var> as value I<val>. I<var> should contain only alphanumerics and underscores, and start with an alphanumeric. I<val> may contain no whitespace. =item B<@@undef> I<var> Undo any previous definition of I<var>. =item B<@@ifdef> I<var> =item B<@@ifndef> I<var> =item B<@@else> =item B<@@endif> If variable I<var> is defined, even defined as a false value, the lines after the @@ifdef are used, otherwise the lines are effectively commented out. @@ifndef is the logical reverse. @@ifdef and @@ifndef must be terminated by an @@endif. They may contain an @@else section that works in the usual way. =item B<@@ifhost> I<name> =item B<@@ifnhost> I<name> These are just like @@ifdef and @@ifndef above, except that they test if the variable I<nodename> is equal to the value supplied for I<name>. =item B<@@ifos> I<name> =item B<@@ifnos> I<name> These are just like @@ifdef and @@ifndef above, except that they test if the variable I<osname> is equal to the value supplied for I<name>. =item B<@@{var}> If this string appears anywhere on any line, then if I<var> is a defined variable, its value is substituted. If I<var> is not a defined variable, the string is left literally. Note that this behaviour is different from that of L<aide(1)>. =item B<@@warn> I<message> Print out I<message> as soon as the config is read. =item B<@@error> I<message> Print out I<message> and exit as soon as the config is read. =back =head1 SORTING You can sort category items using several different criteria. You can set the I<default_sort>, and then on a per-category basis, you can use the I<sort:> keyword to control things even closer. If you don't override it, I<default_sort> defaults to I<funky>. Sorts stack, so you can use "reverse string" or "reverse value". In theory, you can stack all of them, ie. "reverse value reverse funky", but there is no guarantee that sorts are stable. The available sorts are: =over 4 =item B<string> Simple string "lexicographical" sort. Does not handle numbers well. =item B<numeric> Sorts numbers, including decimal numbers, correctly, but cannot handle non-numeric characters, and cannot handle IPs correctly. =item B<funky> Tries to do the right thing with mixed integers and strings. Handles IP addresses correctly. It does not handle decimal numbers correctly. =item B<reverse> Reverses the current order. Can be used in conjunction with another sort, ie. "reverse string". =item B<value> Sorts by count (ascending) instead of by item. =item B<none> Does no additional sorting. =back =head1 FILTERS Sometimes, you don't want to see all the information in a category, just the top few items, or whatever. Filters let you do this. You can set a default filter using I<default_filter> (defaults to "none") or you can set filters on a per-category basis using the I<filter:> keyword. Some commands you can use: =over 4 =item B<E<gt>= >N Only show items whose count is greater than or equal to N. =item B<E<lt>= >N =item B<E<gt> >N =item B<E<lt> >N =item B<= >N, B<== >N =item B<!= >N, B<E<lt>E<gt> >N, B<E<gt>E<lt> >N These are analagous to E<gt>=. =item B<top >N =item B<top >NB<%> =item B<top_strict >N =item B<top_strict >NB<%> Only show those items who count is in the top N or top N%. The difference between I<top> and I<top_strict> is what happens when there's a tie to be in the top N. I<top> will include all the items that tie, even if this means there will be more than N. I<top_strict> always cuts off after N. =item B<bottom >N =item B<bottom >NB<%> =item B<bottom_strict >N =item B<bottom_strict >NB<%> Analagous to top. =item subfilter B<and> subfilter =item subfilter B<or> subfilter Lets you "and" or "or" two or more subfilters togther (ie. "top 10 and E<gt>= 4"). =back =head1 UNIQUE DESTINATION I<log_analysis> has a relatively simple counting mechanism that is usually effective. One exception is when you want to track how often one value occurs in your log uniquely with another value. For example, suppose you're watching firewall logs, $1 is the source IP, $2 is the destination IP, and you want to know if you're being scanned. Tracking counts of "$1 $2" requires you to manually count how many times $1 occurs. Tracking just "$1" doesn't really tell you what you want, because you don't know if the source IP is really scanning a bunch of different hosts, or just has a renegade process that's banging away at a single destination. What you want to track is how many times $1 occurs with a unique $2. To do this sort of thing in a pattern config, set I<format:> to I<value1, value2> and set I<dest:> to "I<UNIQUE> category-name". In our example, we might say: format: $1, $2 dest: UNIQUE scans The fields in format are not evaluated in a string context, and only the last comma acts as a separator. So, if $3 contains the protocol information, you might say this: format: sprintf("%-15s %s", $1, $3), $2 dest: UNIQUE scans When detecting scans in particular, it makes sense to specify an event filter, ie.: category: scans filter: >= 5 Note that it's often useful to specify multiple dests with firewall pattern, ie. one regular category dest, one UNIQUE dest with a filter threshold to detect a scan. If so, you might want to add I<delete_if_unique> to the regular dest, so if it turns out you have a scan, you don't have to wade through lots of garbage. Ie.: pattern: kernel: block from ($pat{ip}):($pat{port}) to ($pat{ip}):($pat{port}) format: $1 => $3:$4 delete_if_unique dest: kernel block format: $1, $3 dest: UNIQUE scans category: scans filter: >=5 =head1 TAG SUBSTITUTIONS A few items are subject to "tag substitutions". These are kind of like printf's "%" sequences: a sequence like "%n" gets replaced with the nodename. You can optionally specify field widths, which default to right-justified (ie. "%10n") or can be preceeded with a "-" to make them left-justified (ie. "%-10n"). Also, a few of the basic C-style backslash sequences are understood (ie. \n for newline, \t for tab, \\ for backslash). Anything subject to tag substitutions will be listed as such. Here are the standard tag sequences: =over 4 =item B<%%> literal % =item B<%n> nodename (ie. the output of I<uname -n>.) =item B<%r> OS release (ie. the output of I<uname -r>.) =item B<%s> OS name (ie. the output of I<uname -s>.) =back There are also other tag sequences that apply in special situations. They are listed where they apply. If you try to use an undefined sequence (ie. "%Z" or something else), you'll get an error. =head1 LOGSERVER CONSIDERATIONS I<log_analysis> defaults to single host operation. If you have a logserver that allows logs from multiple hosts (ie. centralized logging) then you potentially have two concerns: configuring what hostnames to allow, and how to display multi-node logs in report mode. By default, log_analysis will only allow logs from the nodename of the logserver, so if you want to allow other nodes, you need to tell I<log_analysis> which hostnames it should allow logs from. Either set I<allow_nodenames> to a list of nodenames to allow logs from, or set I<process_all_nodenames> (AKA option I<-N>) to accept everything. Another useful variable here is I<leave_FQDNs_alone>. Once you've accepted multiple nodes, there are a number of ways I<log_analysis> can display them. Let's say I received two "Accepted publickey for morty from 192.168.1.1 port 50000 ssh2" events from "red-sonja" and three from "conan". In the default mode, that would look like this: Logs found for other hosts. For host conan: ... sshd: accepted publickey: 3 morty from 192.168.1.1 ... Logs found for other hosts. For host red-sonja: ... sshd: accepted publickey: 2 morty from 192.168.1.1 ... You can get the categories listed together more compactly by setting I<report_mode_output_node_per_category>. Ie: ... sshd: accepted publickey: (host conan) 3 morty from 192.168.1.1 sshd: accepted publickey: (host red-sonja) 2 morty from 192.168.1.1 ... If you set I<report_mode_combine_nodes>, the category will be combined into a single category. Ie.: ... sshd: accepted publickey: 5 morty from 192.168.1.1 ... If you set both I<report_mode_combine_nodes> and I<report_mode_combine_shows_nodes>, you get the combined messages along with a list of applicable hostnames. Ie.: ... sshd: accepted publickey: 5 morty from 192.168.1.1 (conan red-sonja) ... If you set both I<report_mode_combine_nodes> and I<report_mode_combine_is_partway>, the messages are listed like so: ... sshd: accepted publickey: 3 morty from 192.168.1.1 (conan) 2 morty from 192.168.1.1 (red-sonja) ... Other combinations of the variables I<report_mode_output_node_per_category>, I<report_mode_combine_nodes>, I<report_mode_combine_shows_nodes>, and I<report_mode_combine_is_partway> produce undefined results. =head1 EXAMPLES B<log_analysis -m root@whatever> Analyze yesterday's logs and mail the results to root@whatever. You might want to put this in a cronjob. B<log_analysis -p5 -m root@whatever> Same as the last one, but PGP encrypt the logs using PGP 5 before mailing. B<log_analysis -a> Look at all the logs, not just yesterday's. B<log_analysis -sa /var/adm/sulog> Analyze all the contents of sulog, don't bother with local state. B<log_analysis -san otherhost syslog-file> Analyze all the contents of syslog-file, which was created on "otherhost". Don't run the local state commands. B<log_analysis -sd1 -f foo.conf -U> This style of command is useful while developing local configs to handle log messages unknown to the internal config. Use I<foo.conf> as a config file in addition to the internal config. Output only the unknowns. =head1 COMPATIBILITY Written for Solaris and Linux. May work for other OSs. Written for perl 5.00503. May work with some earlier perl versions. =head1 NOTES You often need to be root to read interesting log files. It is customary to regularly "rollover" log files. Many log file formats don't include year infomation; among other benefits, rollover makes the dates in such logfiles unambiguous. B<log_analysis> by default looks for log lines that match a particular day of the year, but does not even try to guess the year. If the OS you're using doesn't rollover some logfiles by default (ie. Solaris doesn't rollover /var/adm/wtmpx, /var/adm/wtmp, or /var/adm/sulog), you will need to rollover these files yourself to get valid output from this program. On some OSes, '%' (ie. the percent symbol) has a special meaning in crontabs, and needs to be commented. See L<crontab(1)>. When there are a lot of unknowns, B<log_analysis> can take a lot longer to run. This is particularly a problem when you're first running it, before you customize for your site. To get around this problem, if you send B<log_analysis> a SIGINT (ie. if you hit control-C), it will stop going through your logs and immediately output the results. =head1 FILES =over 4 =item B</etc/log_analysis.conf> =item B</etc/log_analysis.conf-%n> =item B</etc/log_analysis.conf-%s-%r> =item B</etc/log_analysis.conf-%s> =item B<@prefix@/etc/log_analysis.conf> =item B<@prefix@/etc/log_analysis.conf-%n> =item B<@prefix@/etc/log_analysis.conf-%s-%r> =item B<@prefix@/etc/log_analysis.conf-%s> Config files, in order of precedence. "%n", "%s", and "%r" have the usual tag substitution meanings; see L<"TAG SUBSTITUTIONS">. =item B</etc/log_analysis.d> =item B<@prefix@/etc/log_analysis.d> Plug-in directories. All files in these directories will be treated as config files and include'd. =item B<$HOME/.log_analysis.conf> If you start log_analysis with the "-g" option, this file will be loaded as a config file after all other config files, except those specified by I<-f>. This is also the default file for the "save config" menu option. =back =head1 AUTHOR Mordechai T. Abzug <morty@frakir.org> =head1 See Also L<syslogd(8)>, L<last(1)>, L<perlre(1)> =cut