X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=src%2Flogger.pl;h=3ad021abcbd4953a473ab38051d46151c5d876ef;hb=f06ee2cec2996f92167474845aee2f5112588288;hp=402c46c079bf1090e79c811a050d8168f85a5273;hpb=10e28f9bfeec2a46fb434f8165f419981054693d;p=infobot.git diff --git a/src/logger.pl b/src/logger.pl index 402c46c..3ad021a 100644 --- a/src/logger.pl +++ b/src/logger.pl @@ -1,55 +1,77 @@ # # logger.pl: logger functions! # Author: dms -# Version: v0.3 (20000731) +# Version: v0.4 (20000923) # FVersion: 19991205 # NOTE: Based on code by Kevin Lenzo & Patrick Cole (c) 1997 # use strict; +use utf8; -use vars qw($logDate $loggingstatus $statcount $bot_pid - $statcountfix $addressed $logcount $logtime); +use vars qw($statcount $bot_pid $forkedtime $statcountfix $addressed); +use vars qw($logDate $logold $logcount $logtime $logrepeat $running); use vars qw(@backlog); -use vars qw(%param %file); +use vars qw(%param %file %cache); -require 5.001; +$logtime = time(); +$logcount = 0; +$logrepeat = 0; +$logold = ''; -$logtime = time(); +$param{VEBOSITY} ||= 1; # lame fix for preload my %attributes = ( - 'clear' => 0, - 'reset' => 0, - 'bold' => 1, - 'underline' => 4, - 'underscore' => 4, - 'blink' => 5, - 'reverse' => 7, - 'concealed' => 8, - 'black' => 30, 'on_black' => 40, - 'red' => 31, 'on_red' => 41, - 'green' => 32, 'on_green' => 42, - 'yellow' => 33, 'on_yellow' => 43, - 'blue' => 34, 'on_blue' => 44, - 'magenta' => 35, 'on_magenta' => 45, - 'cyan' => 36, 'on_cyan' => 46, - 'white' => 37, 'on_white' => 47 + 'clear' => 0, + 'reset' => 0, + 'bold' => 1, + 'underline' => 4, + 'underscore' => 4, + 'blink' => 5, + 'reverse' => 7, + 'concealed' => 8, + 'black' => 30, + 'on_black' => 40, + 'red' => 31, + 'on_red' => 41, + 'green' => 32, + 'on_green' => 42, + 'yellow' => 33, + 'on_yellow' => 43, + 'blue' => 34, + 'on_blue' => 44, + 'magenta' => 35, + 'on_magenta' => 45, + 'cyan' => 36, + 'on_cyan' => 46, + 'white' => 37, + 'on_white' => 47 ); use vars qw($b_black $_black $b_red $_red $b_green $_green - $b_yellow $_yellow $b_blue $_blue $b_magenta $_magenta - $b_cyan $_cyan $b_white $_white $_reset $_bold $ob $b); - -$b_black = cl('bold black'); $_black = cl('black'); -$b_red = cl('bold red'); $_red = cl('red'); -$b_green = cl('bold green'); $_green = cl('green'); -$b_yellow = cl('bold yellow'); $_yellow = cl('yellow'); -$b_blue = cl('bold blue'); $_blue = cl('blue'); -$b_magenta = cl('bold magenta'); $_magenta = cl('magenta'); -$b_cyan = cl('bold cyan'); $_cyan = cl('cyan'); -$b_white = cl('bold white'); $_white = cl('white'); -$_reset = cl('reset'); $_bold = cl('bold'); -$ob = cl('reset'); $b = cl('bold'); + $b_yellow $_yellow $b_blue $_blue $b_magenta $_magenta + $b_cyan $_cyan $b_white $_white $_reset $_bold $ob $b); + +$b_black = cl('bold black'); +$_black = cl('black'); +$b_red = cl('bold red'); +$_red = cl('red'); +$b_green = cl('bold green'); +$_green = cl('green'); +$b_yellow = cl('bold yellow'); +$_yellow = cl('yellow'); +$b_blue = cl('bold blue'); +$_blue = cl('blue'); +$b_magenta = cl('bold magenta'); +$_magenta = cl('magenta'); +$b_cyan = cl('bold cyan'); +$_cyan = cl('cyan'); +$b_white = cl('bold white'); +$_white = cl('white'); +$_reset = cl('reset'); +$_bold = cl('bold'); +$ob = cl('reset'); +$b = cl('bold'); ############################################################################ # Implementation (attribute string form) @@ -60,96 +82,102 @@ sub cl { my @codes = map { split } @_; my $attribute = ''; foreach (@codes) { - $_ = lc $_; - unless (defined $attributes{$_}) { die "Invalid attribute name $_" } - $attribute .= $attributes{$_} . ';'; + $_ = lc $_; + unless ( defined $attributes{$_} ) { die "Invalid attribute name $_" } + $attribute .= $attributes{$_} . ';'; } chop $attribute; - ($attribute ne '') ? "\e[${attribute}m" : undef; + ( $attribute ne '' ) ? "\e[${attribute}m" : undef; } # logging support. sub openLog { - return unless (&IsParam("logfile")); + binmode( STDOUT, ':encoding(UTF-8)' ); + return unless ( &IsParam('logfile') ); $file{log} = $param{'logfile'}; my $error = 0; - my $path = &getPath($file{log}); - while (! -d $path) { - if ($error) { - &ERROR("openLog: failed opening log to $file{log}; disabling."); - delete $param{'logfile'}; - return; - } - - &status("openLog: making $path."); - last if (mkdir $path, 0755); - $error++; + my $path = &getPath( $file{log} ); + while ( !-d $path ) { + if ($error) { + &ERROR("openLog: failed opening log to $file{log}; disabling."); + delete $param{'logfile'}; + return; + } + + &status("openLog: making $path."); + last if ( mkdir $path, 0755 ); + $error++; } - if (&IsParam("logType") and $param{'logType'} =~ /DAILY/i) { - my ($day,$month,$year) = (localtime(time()))[3,4,5]; - $logDate = sprintf("%04d%02d%02d",$year+1900,$month+1,$day); - $file{log} .= "-".$logDate; + if ( &IsParam('logType') and $param{'logType'} =~ /DAILY/i ) { + my ( $day, $month, $year ) = ( gmtime time() )[ 3, 4, 5 ]; + my $logDir = $file{log} . sprintf('%04d', $year + 1900); + unless(-d $logDir) { + &status("openLog: making $logDir."); + mkdir $logDir, 0755 or &status("Cannot mkdir $logDir");; + } + $logDate = sprintf('%04d/%02d%02d', $year + 1900, $month + 1, $day); + $file{log} .= $logDate; } - if (open(LOG, ">>$file{log}")) { - &status("Opened logfile $file{log}."); - LOG->autoflush(1); - $loggingstatus = 1; - } else { - &status("cannot open logfile $file{log}; disabling."); - $loggingstatus = 0; + + if ( open( LOG, ">>$file{log}" ) ) { + binmode( LOG, ':encoding(UTF-8)' ); + &status("Opened logfile $file{log}."); + LOG->autoflush(1); + } + else { + &status("Cannot open logfile ($file{log}); not logging: $!"); } } sub closeLog { + # lame fix for paramlogfile. - return unless (&IsParam("logfile")); - return unless ($loggingstatus); + return unless ( &IsParam('logfile') ); + return unless ( defined fileno LOG ); - $loggingstatus = 0; - &status("Closed logfile ($file{log})."); close LOG; + &status("Closed logfile ($file{log})."); } ##### -# Usage: &compress($file); -sub compress { +# Usage: &processLog($file); +sub processLog { my ($file) = @_; - my @compress = ("/usr/bin/bzip2","/bin/gzip"); + my @processLog = ( 'scripts/processlog', '/usr/bin/bzip2', '/bin/bzip2', '/bin/gzip' ); my $okay = 0; - if (! -f $file) { - # ironically this does not get logged :) - &WARN("compress: file ($file) does not exist."); - return 0; + if ( !-f $file ) { + &WARN("processLog: file ($file) does not exist."); + return 0; } - if (-f "$file.gz" or -f "$file.bz2") { - &WARN("compress: file.(gz|bz2) already exists."); - return 0; + if ( -f "$file.gz" or -f "$file.bz2" ) { + &WARN('processLog: file.(gz|bz2) already exists.'); + return 0; } - foreach (@compress) { - next unless ( -x $_); + foreach (@processLog) { + next unless ( -x $_ ); - &status("Compressing '$file' with $_."); - system("$_ $file &"); - $okay++; - last; + &status("Processing log '$file' with $_."); + system("$_ $file &"); + $okay++; + last; } - if (!$okay) { - &ERROR("no compress program found."); - return 0; + if ( !$okay ) { + &ERROR('no processLog program found.'); + return 0; } return 1; } sub DEBUG { - return unless (&IsParam("DEBUG")); + return unless ( &IsParam('DEBUG') ); &status("${b_green}!DEBUG!$ob $_[0]"); } @@ -159,13 +187,15 @@ sub ERROR { } sub WARN { - return unless (&IsParam("WARN")); + return unless ( &IsParam('WARN') ); + + return if ( $_[0] =~ /^PERL: Subroutine \S+ redefined at/ ); &status("${b_yellow}!WARN!$ob $_[0]"); } sub FIXME { - &status("${b_cyan}!FIXME!$ob $_[0] (SHOULD NOT HAPPEN?)"); + &status("${b_cyan}!FIXME!$ob $_[0]"); } sub TODO { @@ -173,142 +203,296 @@ sub TODO { } sub VERB { - if (!&IsParam("VERBOSITY")) { - # NOTHING. - } elsif ($param{'VERBOSITY'} eq "1" and $_[1] <= 1) { - &status($_[0]); - } elsif ($param{'VERBOSITY'} eq "2" and $_[1] <= 2) { - &status($_[0]); + if ( !&IsParam('VERBOSITY') ) { + + # NOTHING. + } + elsif ( $param{'VERBOSITY'} eq '1' and $_[1] <= 1 ) { + &status( $_[0] ); + } + elsif ( $param{'VERBOSITY'} eq '2' and $_[1] <= 2 ) { + &status( $_[0] ); } } sub status { - my($input) = @_; + my ($input) = @_; my $status; - # return if input is null'ish. - return '' if ($input =~ /^\s*$/); - $input =~ s/\n+$//; - $input =~ s/\002|037//g; # bold,video,underline => remove. + if ( $input =~ /PERL: Use of uninitialized/ ) { + &debug_perl($input); + return; + } + + if ( $input eq $logold ) { + $logrepeat++; + return; + } + + $logold = $input; + + # if only I had followed how sysklogd does it, heh. lame me. -xk + if ( $logrepeat >= 3 ) { + &status("LOG: last message repeated $logrepeat times"); + $logrepeat = 0; + } + + # if it's not a scalar, attempt to warn and fix. + my $ref = ref $input; + if ( defined $ref and $ref ne '' ) { + &WARN("status: 'input' is not scalar ($ref)."); + + if ( $ref eq 'ARRAY' ) { + foreach (@$input) { + &WARN("status: '$_'."); + } + } + } + + # Something is using this w/ NULL. + if ( !defined $input or $input =~ /^\s*$/ ) { + $input = 'ERROR: Blank status call? HELP HELP HELP'; + } + + for ($input) { + s/\n+$//; + s/\002|\037//g; # bold,video,underline => remove. + } - # pump up the stats (or loglinenum). + # does this work? + if ( $input =~ /\n/ ) { + foreach ( split /\n/, $input ) { + &status($_); + } + } + + # pump up the stats. $statcount++; # fix style of output if process is child. - if (defined $bot_pid and $$ != $bot_pid and !defined $statcountfix) { - $statcount = 1; - $statcountfix = 1; + if ( defined $bot_pid and $$ != $bot_pid and !defined $statcountfix ) { + $statcount = 1; + $statcountfix = 1; } ### LOG THROTTLING. ### TODO: move this _after_ printing? - my $time = time(); + my $time = time(); my $reset = 0; - if ($logtime != $time) { - $reset++; - } elsif ($logtime == $time) { - if ($logcount < 25) { # too high? - $logcount++; - } else { - sleep 1; - &status("LOG: Throttling."); # recursive? - $reset++; - } + + # hrm... what is this supposed to achieve? nothing I guess. + if ( $logtime == $time ) { + if ( $logcount < 25 ) { # too high? + $logcount++; + } + else { + sleep 1; + &status('LOG: Throttling.'); + $reset++; + } + } + else { # $logtime != $time. + $reset++; } + if ($reset) { - $logtime = $time; - $logcount = 0; + $logtime = $time; + $logcount = 0; } # Log differently for forked/non-forked output. if ($statcountfix) { - $status = "!$statcount! ".$input; - if ($statcount > 1000) { - print LOG "ERROR: FORKED PROCESS RAN AWAY; KILLING.\n"; - print LOG "VERB: ".(&Time2String(time() - $forkedtime))."\n"; - exit 0; - } - } else { - $status = "[$statcount] ".$input; - } - - if (&IsParam("backlog")) { - push(@backlog, $status); # append to end. - shift(@backlog) if (scalar @backlog > $param{'backlog'}); - } - - if (&IsParam("VERBOSITY")) { - if ($statcountfix) { - printf $_red."!%5d!".$ob." ", $statcount; - } else { - printf $_green."[%5d]".$ob." ", $statcount; - } - - # three uberstabs to Derek Moeller. - my $printable = $input; - - if ($printable =~ s/^(<\/\S+>) //) { - # it's me saying something on a channel - my $name = $1; - print "$b_yellow$name $printable$ob\n"; - } elsif ($printable =~ s/^(<\S+>) //) { - # public message on channel. - my $name = $1; - - if ($addressed) { - print "$b_red$name $printable$ob\n"; - } else { - print "$b_cyan$name$ob $printable$ob\n"; - } - - } elsif ($printable =~ s/^\* (\S+)\/(\S+) //) { - # public action. - print "$b_white*$ob $b_cyan$1$ob/$b_blue$2$ob $printable\n"; - } elsif ($printable =~ s/^(-\S+-) //) { - # notice - print "$_green$1 $printable$ob\n"; - } elsif ($printable =~ s/^(\* )?(\[\S+\]) //) { - # message/private action from someone - print "$b_white$1$ob" if (defined $1); - print "$b_red$2 $printable$ob\n"; - } elsif ($printable =~ s/^(>\S+<) //) { - # i'm messaging someone - print "$b_magenta$1 $printable$ob\n"; - } elsif ($printable =~ s/^(enter:|update:|forget:) //) { - # something that should be SEEN - print "$b_green$1 $printable$ob\n"; - } else { - print "$printable\n"; - } - } else { - print "VERBOSITY IS OFF?\n"; + $status = "!$statcount! " . $input; + if ( $statcount > 1000 ) { + print LOG "ERROR: FORKED PROCESS RAN AWAY; KILLING.\n"; + print LOG 'VERB: ' . ( &Time2String( $time - $forkedtime ) ) . "\n"; + exit 0; + } + } + else { + $status = "[$statcount] " . $input; } - # log the line into a file. - return unless (&IsParam("logfile")); - return unless ($loggingstatus); + if ( &IsParam('backlog') ) { + push( @backlog, $status ); # append to end. + shift(@backlog) if ( scalar @backlog > $param{'backlog'} ); + } + + if ( &IsParam('VERBOSITY') ) { + if ($statcountfix) { + printf $_red. '!%6d!' . $ob . ' ', $statcount; + } + else { + printf $_green. '[%6d]' . $ob . ' ', $statcount; + } + + # three uberstabs to Derek Moeller. I don't remember why but he + # deserved it :) + my $printable = $input; + + if ( $printable =~ s/^(<\/\S+>) // ) { + + # it's me saying something on a channel + my $name = $1; + print "$b_yellow$name $printable$ob\n"; + } + elsif ( $printable =~ s/^(<\S+>) // ) { + + # public message on channel. + my $name = $1; - # remove control characters from logging. - $input =~ s/\e\[[0-9;]+m//g; - $input =~ s/[\cA-\c_]//g; - $input = "FORK($$) ".$input if ($statcountfix); + if ($addressed) { + print "$b_red$name $printable$ob\n"; + } + else { + print "$b_cyan$name$ob $printable$ob\n"; + } + + } + elsif ( $printable =~ s/^\* (\S+)\/(\S+) // ) { + + # public action. + print "$b_white*$ob $b_cyan$1$ob/$b_blue$2$ob $printable\n"; + + } + elsif ( $printable =~ s/^(-\S+-) // ) { + + # notice + print "$_green$1 $printable$ob\n"; + + } + elsif ( $printable =~ s/^(\* )?(\[\S+\]) // ) { + + # message/private action from someone + print "$b_white$1$ob" if ( defined $1 ); + print "$b_red$2 $printable$ob\n"; + + } + elsif ( $printable =~ s/^(>\S+<) // ) { + + # i'm messaging someone + print "$b_magenta$1 $printable$ob\n"; + + } + elsif ( $printable =~ s/^(enter:|update:|forget:) // ) { + + # something that should be SEEN + print "$b_green$1 $printable$ob\n"; + + } + else { + print "$printable\n"; + } + + } + else { + + #print "VERBOSITY IS OFF?\n"; + } + + # log the line into a file. + return unless ( &IsParam('logfile') ); + return unless ( defined fileno LOG ); + + # remove control characters from logging to LOGFILE. + for ($input) { + last if ( &IsParam('logColors') ); + s/\e\[[0-9;]+m//g; # escape codes. + s/[\cA-\c_]//g; # control chars. + } + $input = "FORK($$) " . $input if ($statcountfix); my $date; - if (&IsParam("logType") and $param{'logType'} =~ /DAILY/i) { - $date = sprintf("%02d:%02d.%02d", (localtime(time()))[2,1,0]); + if ( &IsParam('logType') and $param{'logType'} =~ /DAILY/i ) { + $date = sprintf( '%02d:%02d.%02d', ( gmtime $time )[ 2, 1, 0 ] ); + + my ( $day, $month, $year ) = ( gmtime $time )[ 3, 4, 5 ]; + my $newlogDate = + sprintf( '%04d/%02d%02d', $year + 1900, $month + 1, $day ); + if ( defined $logDate and $newlogDate ne $logDate ) { + &closeLog(); + &processLog( $file{log} ); + &openLog(); + } + } + else { + $date = $time; + } + + printf LOG "%s %s\n", $date, $input; +} + +sub debug_perl { + my ($str) = @_; + + return + unless ( + $str =~ /^WARN: Use of uninitialized value .* at (\S+) line (\d+)/ ); + my ( $file, $line ) = ( $1, $2 ); + if ( !open( IN, $file ) ) { + &status("WARN: cannot open $file: $!"); + return; + } + binmode( IN, ':encoding(UTF-8)' ); + + # TODO: better filename. + open( OUT, '>>debug.log' ); + binmode( OUT, ':encoding(UTF-8)' ); + print OUT "DEBUG: $str\n"; + + # note: cannot call external functions because SIG{} does not allow us to. + my $i; + while () { + chop; + $i++; + + # bleh. this tries to duplicate status(). + # TODO: statcountfix + # TODO: rename to log_*someshit* + if ( $i == $line ) { + my $msg = "$file: $i:!$_"; + printf "%s[%6d]%s %s\n", $_green, $statcount, $ob, $msg; + print OUT "DEBUG: $msg\n"; + $statcount++; + next; + } + if ( $i + 3 > $line && $i - 3 < $line ) { + my $msg = "$file: $i: $_"; + printf "%s[%6d]%s %s\n", $_green, $statcount, $ob, $msg; + print OUT "DEBUG: $msg\n"; + $statcount++; + } + } + close IN; + close OUT; +} - my ($day,$month,$year) = (localtime(time()))[3,4,5]; - my $newlogDate = sprintf("%04d%02d%02d",$year+1900,$month+1,$day); - if (defined $logDate and $newlogDate != $logDate) { - &closeLog(); - &compress($file{log}); - &openLog(); - } - } else { - $date = time(); +sub openSQLDebug { + if ( !open( SQLDEBUG, ">>$param{'SQLDebug'}" ) ) { + &ERROR("Cannot open ($param{'SQLDebug'}): $!"); + delete $param{'SQLDebug'}; + return 0; } + binmode( SQLDEBUG, ':encoding(UTF-8)' ); - print LOG sprintf("%s %s\n", $date, $input); + &status("Opened SQL Debug file: $param{'SQLDebug'}"); + return 1; +} + +sub closeSQLDebug { + close SQLDEBUG; + + &status("Closed SQL Debug file: $param{'SQLDebug'}"); +} + +sub SQLDebug { + return unless ( &IsParam('SQLDebug') ); + + return unless ( fileno SQLDEBUG ); + + print SQLDEBUG $_[0] . "\n"; } 1; + +# vim:ts=4:sw=4:expandtab:tw=80