X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=src%2Fcore.pl;h=ecbcee5f7c9388019e495797b910f66a920bc9fc;hb=d2831f6af012fb356e8b0f9b00bbb98e16eba940;hp=da909ce9b8741a754ecc615b9e9c8136e9eb0e12;hpb=99f86352e2eff21f5eef65c16c41b44e1bfa17b6;p=infobot.git diff --git a/src/core.pl b/src/core.pl index da909ce..ecbcee5 100644 --- a/src/core.pl +++ b/src/core.pl @@ -7,7 +7,7 @@ use strict; -# dynamic scalar. MUST BE REDUCED IN SIZE!!! +# scalar. MUST BE REDUCED IN SIZE!!! ### TODO: reorder. use vars qw( $bot_misc_dir $bot_pid $bot_base_dir $bot_src_dir @@ -26,16 +26,16 @@ use vars qw( $running ); -# dynamic hash. -use vars qw(@joinchan @ircServers @wingateBad @wingateNow @wingateCache +# array. +use vars qw(@ircServers @wingateBad @wingateNow @wingateCache ); -### dynamic hash. MUST BE REDUCED IN SIZE!!! -# +### hash. MUST BE REDUCED IN SIZE!!! +# use vars qw(%count %netsplit %netsplitservers %flood %dcc %orig %nuh %talkWho %seen %floodwarn %param %dbh %ircPort %topic %moduleAge %last %time %mask %file - %forked %chanconf %channels + %forked %chanconf %channels %cache ); # Signals. @@ -49,7 +49,7 @@ $SIG{'__WARN__'} = 'doWarn'; $last{buflen} = 0; $last{say} = ""; $last{msg} = ""; -$userHandle = "default"; +$userHandle = "_default"; $wingaterun = time(); $firsttime = 1; $utime_userfile = 0; @@ -60,6 +60,14 @@ $wtime_chanfile = 0; $ucount_chanfile = 0; $running = 0; ### more variables... +# static scalar variables. +$mask{ip} = '(\d+)\.(\d+)\.(\d+)\.(\d+)'; +$mask{host} = '[\d\w\_\-\/]+\.[\.\d\w\_\-\/]+'; +$mask{chan} = '[\#\&]\S*|_default'; +my $isnick1 = 'a-zA-Z\[\]\{\}\_\`\^\|\\\\'; +my $isnick2 = '0-9\-'; +$mask{nick} = "[$isnick1]{1}[$isnick1$isnick2]*"; +$mask{nuh} = '\S*!\S*\@\S*'; $msgtime = time(); $msgsize = 0; $msgcount = 0; @@ -70,11 +78,10 @@ $nottime = 0; $notsize = 0; $notcount = 0; ### +$bot_release = "1.3.3"; if ( -d "CVS" ) { use POSIX qw(strftime); - $bot_release = strftime("cvs (%Y%m%d)", localtime( (stat("CVS"))[9] ) ); -} else { - $bot_release = "1.0.10 (2001xxxx)"; + $bot_release .= strftime(" cvs (%Y%m%d)", gmtime( (stat("CVS"))[9] ) ); } $bot_version = "blootbot $bot_release -- $^O"; $noreply = "NOREPLY"; @@ -83,6 +90,14 @@ $noreply = "NOREPLY"; ### misc commands. ### +sub whatInterface { + if (!&IsParam("Interface") or $param{'Interface'} =~ /IRC/) { + return "IRC"; + } else { + return "CLI"; + } +} + sub doExit { my ($sig) = @_; @@ -100,18 +115,26 @@ sub doExit { &status("--- Start of quit."); $ident ||= "blootbot"; # lame hack. - &closeDCC() if (&whatInterface() =~ /IRC/); + &status("Memory Usage: $memusage KiB"); + &closePID(); &closeStats(); - &seenFlush() if (&whatInterface() =~ /IRC/); - &quit($param{'quitMsg'}) if (&whatInterface() =~ /IRC/); + # shutdown IRC and related components. + if (&whatInterface() =~ /IRC/) { + &closeDCC(); + &seenFlush(); + &quit($param{'quitMsg'}); + } &writeUserFile(); &writeChanFile(); - &uptimeWriteFile() if (&ChanConfList("uptime")); - &News::writeNews() if (&ChanConfList("news")); - &closeDB(); + &uptimeWriteFile() if (&IsParam('Uptime')); + &sqlCloseDB(); &closeSHM($shm); - &dumpallvars() if (&IsParam("dumpvarsAtExit")); + + if (&IsParam("dumpvarsAtExit")) { + &loadMyModule('DumpVars'); + &dumpallvars(); + } &symdumpAll() if (&IsParam("symdumpAtExit")); &closeLog(); &closeSQLDebug() if (&IsParam("SQLDebug")); @@ -174,8 +197,8 @@ sub getChanConfList { foreach (keys %chanconf) { my $chan = $_; -# &DEBUG("chan => $chan"); my @array = grep /^$param$/, keys %{ $chanconf{$chan} }; + #&DEBUG("gCCL param => $param, chan => $chan, keys => " . join(':',keys %{ $chanconf{$chan} }) . " array => " . join(':', @array)) if ($param eq 'whatever'); next unless (scalar @array); @@ -183,7 +206,7 @@ sub getChanConfList { &WARN("multiple items found?"); } - if ($array[0] eq "0") { + if ($chanconf{$chan}{$param} eq "0") { $chan{$chan} = -1; } else { $chan{$chan} = 1; @@ -199,14 +222,23 @@ sub getChanConfList { # Return: 1 for enabled, 0 for passive disable, -1 for active disable. sub IsChanConf { my($param) = shift; - my $debug = 0; # knocked tons of bugs with this! :) + + # knocked tons of bugs with this! :) + my $debug = 0; # 1 if ($param eq "whatever"); if (!defined $param) { &WARN("IsChanConf: param == NULL."); return 0; } - $chan ||= "_default"; + # these should get moved to your .chan file instead of the .config + # .config items overide any .chan entries + if (&IsParam($param)) { + &WARN("ICC: found '$param' option in main config file."); + return 1; + } + + $chan ||= "_default"; my $old = $chan; if ($chan =~ tr/A-Z/a-z/) { @@ -224,9 +256,11 @@ sub IsChanConf { } ### debug purposes only. -# &DEBUG("param => $param, msgType => $msgType."); -# foreach (keys %chan) { -# &DEBUG(" $_ => $chan{$_}"); +# if ($debug) { +# &DEBUG("param => $param, msgType => $msgType."); +# foreach (keys %chan) { +# &DEBUG(" $_ => $chan{$_}"); +# } # } if ($nomatch) { @@ -237,31 +271,15 @@ sub IsChanConf { } else { &DEBUG("ICC: other: 0 ($param)") if ($debug); } - return $chan{$chan} || $chan{_default} || 0; - } - - if ($msgType eq "public") { + } elsif ($msgType =~ /^(public|private)$/i) { if ($chan{$chan}) { - &DEBUG("ICC: public: $chan{$chan} ($chan/$param)") if ($debug); + &DEBUG("ICC: $msgType: $chan{$chan} ($chan/$param)") if ($debug); } elsif ($chan{_default}) { - &DEBUG("ICC: public: $chan{_default} (_default/$param)") if ($debug); + &DEBUG("ICC: $msgType: $chan{_default} (_default/$param)") if ($debug); } else { - &DEBUG("ICC: public: 0 ($param)") if ($debug); + &DEBUG("ICC: $msgType: 0 ($param)") if ($debug); } - - return $chan{$chan} || $chan{_default} || 0; - } - - if ($msgType eq "private") { - if ($chan{_default}) { - &DEBUG("ICC: private: $chan{_default} (_default/$param)") if ($debug); - } elsif ($chan{$chan}) { - &DEBUG("ICC: private: $chan{$chan} ($chan/$param) (hack)") if ($debug); - } else { - &DEBUG("ICC: private: 0 ($param)") if ($debug); - } - return $chan{$chan} || $chan{_default} || 0; } @@ -278,37 +296,42 @@ sub getChanConf { my($param,$c) = @_; if (!defined $param) { - &WARN("param == NULL."); + &WARN("gCC: param == NULL."); return 0; } - # this looks evil... + # this looks evil... if (0 and !defined $chan) { &DEBUG("gCC: ok !chan... doing _default instead."); } $c ||= $chan; $c ||= "_default"; - $c = "_default" if ($c eq "*"); # fix! - my @c = grep /^$c$/i, keys %chanconf; + $c = "_default" if ($c eq "*"); # FIXME + my @c = grep /^\Q$c\E$/i, keys %chanconf; if (@c) { if (0 and $c[0] ne $c) { &WARN("c ne chan ($c[0] ne $chan)"); } + if (!defined $chanconf{$c[0]}{$param} and ($c ne '_default')) { + return &getChanConf($param, '_default'); + } + #&DEBUG("gCC: $param,$c \"" . $chanconf{$c[0]}{$param} . '"'); return $chanconf{$c[0]}{$param}; } -# &DEBUG("gCC: returning _default... "); + #&DEBUG("gCC: returning _default... " . $chanconf{"_default"}{$param}); return $chanconf{"_default"}{$param}; } sub getChanConfDefault { my($what, $default, $chan) = @_; + $chan ||= "_default"; if (exists $param{$what}) { if (!exists $cache{config}{$what}) { - &status("conf: backward-compat: found param{$what} ($param{$what}) instead."); + &status("config ($chan): backward-compatible option: found param{$what} ($param{$what}) instead of chan option"); $cache{config}{$what} = 1; } @@ -318,7 +341,7 @@ sub getChanConfDefault { return $val if (defined $val); $param{$what} = $default; - &status("conf: auto-setting param{$what} = $default"); + &status("config ($chan): auto-setting param{$what} = $default"); $cache{config}{$what} = 1; return $default; } @@ -341,7 +364,6 @@ sub findChanConf { foreach (keys %{ $chanconf{$c} }) { next unless (/^$param$/); - &DEBUG("chanconf{$c}{$_} ..."); return $chanconf{$c}{$_}; } } @@ -364,7 +386,7 @@ sub showProc { close IN; } elsif ($^O eq "netbsd") { - $memusage = (stat "/proc/$$/mem")[7]/1024; + $memusage = int( (stat "/proc/$$/mem")[7]/1024 ); } elsif ($^O =~ /^(free|open)bsd$/) { my @info = split /\s+/, `/bin/ps -l -p $$`; @@ -382,13 +404,13 @@ sub showProc { if ($delta == 0) { return; } elsif ($delta > 500) { - $str = "MEM:$prefix increased by $delta kB. (total: $memusage kB)"; + $str = "MEM:$prefix increased by $delta KiB. (total: $memusage KiB)"; } elsif ($delta > 0) { - $str = "MEM:$prefix increased by $delta kB"; + $str = "MEM:$prefix increased by $delta KiB"; } else { # delta < 0. $delta = -$delta; # never knew RSS could decrease, probably Size can't? - $str = "MEM:$prefix decreased by $delta kB."; + $str = "MEM:$prefix decreased by $delta KiB."; } &status($str); @@ -405,13 +427,6 @@ sub setup { &openLog(); # write, append. &status("--- Started logging."); - foreach ("debian") { - my $dir = "$bot_base_dir/$_/"; - next if ( -d $dir); - &status("Making dir $_"); - mkdir $dir, 0755; - } - # read. &loadLang($bot_data_dir. "/blootbot.lang"); &loadIRCServers(); @@ -421,21 +436,21 @@ sub setup { $shm = &openSHM(); &openSQLDebug() if (&IsParam("SQLDebug")); - &openDB($param{'DBName'}, $param{'SQLUser'}, $param{'SQLPass'}); + &sqlOpenDB($param{'DBName'}, $param{'DBType'}, $param{'SQLUser'}, + $param{'SQLPass'}); &checkTables(); &status("Setup: ". &countKeys("factoids") ." factoids."); - &News::readNews() if (&ChanConfList("news")); - &getChanConfDefault("sendPrivateLimitLines", 3); - &getChanConfDefault("sendPrivateLimitBytes", 1000); - &getChanConfDefault("sendPublicLimitLines", 3); - &getChanConfDefault("sendPublicLimitBytes", 1000); - &getChanConfDefault("sendNoticeLimitLines", 3); - &getChanConfDefault("sendNoticeLimitBytes", 1000); + &getChanConfDefault("sendPrivateLimitLines", 3, $chan); + &getChanConfDefault("sendPrivateLimitBytes", 1000, $chan); + &getChanConfDefault("sendPublicLimitLines", 3, $chan); + &getChanConfDefault("sendPublicLimitBytes", 1000, $chan); + &getChanConfDefault("sendNoticeLimitLines", 3, $chan); + &getChanConfDefault("sendNoticeLimitBytes", 1000, $chan); $param{tempDir} =~ s#\~/#$ENV{HOME}/#; - &status("Initial memory usage: $memusage kB"); + &status("Initial memory usage: $memusage KiB"); &status("-------------------------------------------------------"); } @@ -443,7 +458,7 @@ sub setupConfig { $param{'VERBOSITY'} = 1; &loadConfig($bot_config_dir."/blootbot.config"); - foreach ("ircNick", "ircUser", "ircName", "DBType", "tempDir") { + foreach ( qw(ircNick ircUser ircName DBType tempDir) ) { next if &IsParam($_); &ERROR("Parameter $_ has not been defined."); exit 1; @@ -471,7 +486,7 @@ sub setupConfig { sub startup { if (&IsParam("DEBUG")) { &status("enabling debug diagnostics."); - ### I thought disabling this reduced memory usage by 1000 kB. + # I thought disabling this reduced memory usage by 1000 KiB. use diagnostics; } @@ -482,19 +497,24 @@ sub startup { } sub shutdown { + my ($sig) = @_; # reverse order of &setup(). &status("--- shutdown called."); - $ident ||= "blootbot"; # hack. + # hack. + $ident ||= "blootbot"; - # opened files must be written to on shutdown/hup/whatever - # unless they're write-only, like uptime. - &writeUserFile(); - &writeChanFile(); - &News::writeNews() if (&ChanConfList("news")); + if (!&isFileUpdated("$bot_state_dir/blootbot.users", $wtime_userfile)) { + &writeUserFile() + } + + if (!&isFileUpdated("$bot_state_dir/blootbot.chan", $wtime_chanfile)) { + &writeChanFile(); + } - &closeDB(); - &closeSHM($shm); # aswell. TODO: use this in &doExit? + &sqlCloseDB(); + # aswell. TODO: use this in &doExit? + &closeSHM($shm); &closeLog(); } @@ -505,8 +525,10 @@ sub restart { &status("--- $sig called."); ### crappy bug in Net::IRC? - if (!$conn->connected and time - $msgtime > 900) { - &status("reconnecting because of uncaught disconnect \@ ".scalar(localtime) ); + my $delta = time() - $msgtime; + &DEBUG("restart: dtime = $delta"); + if (!$conn->connected or time() - $msgtime > 900) { + &status("reconnecting because of uncaught disconnect \@ ".scalar(gmtime) ); ### $irc->start; &clearIRCVars(); $conn->connect(); @@ -516,7 +538,7 @@ sub restart { &ircCheck(); # heh, evil! &DCCBroadcast("-HUP called.","m"); - &shutdown(); + &shutdown($sig); &loadConfig($bot_config_dir."/blootbot.config"); &reloadAllModules() if (&IsParam("DEBUG")); &setup();