X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=src%2Fcore.pl;h=802e4c20a72da8c33dd51a4a3440f5ff4d42499d;hb=f7cae48a17d6decd0a9bd997188271daa0a885b1;hp=28c24bdf5951a1758038f661b70b78d79752c3cf;hpb=9297b6322dc6a785b2ba574a59425a24ef8daf19;p=infobot.git diff --git a/src/core.pl b/src/core.pl index 28c24bd..802e4c2 100644 --- a/src/core.pl +++ b/src/core.pl @@ -7,10 +7,11 @@ 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 + $bot_data_dir $bot_config_dir $bot_state_dir $bot_run_dir $answer $correction_plausible $talkchannel $bot_release $statcount $memusage $user $memusageOld $bot_version $dbh $shm $host $msg $noreply $conn $irc $learnok $nick $ident @@ -25,12 +26,12 @@ use vars qw( $running ); -# dynamic hash. +# array. use vars qw(@joinchan @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 @@ -48,7 +49,7 @@ $SIG{'__WARN__'} = 'doWarn'; $last{buflen} = 0; $last{say} = ""; $last{msg} = ""; -$userHandle = "default"; +$userHandle = "_default"; $wingaterun = time(); $firsttime = 1; $utime_userfile = 0; @@ -59,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; @@ -69,11 +78,10 @@ $nottime = 0; $notsize = 0; $notcount = 0; ### +$bot_release = "1.1.0"; 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"; @@ -82,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) = @_; @@ -99,18 +115,23 @@ sub doExit { &status("--- Start of quit."); $ident ||= "blootbot"; # lame hack. - &closeDCC(); + &status("Memory Usage: $memusage KiB"); + &closePID(); &closeStats(); - &seenFlush(); - &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 (&IsChanConf("uptime")); + &sqlCloseDB(); &closeSHM($shm); &dumpallvars() if (&IsParam("dumpvarsAtExit")); + &symdumpAll() if (&IsParam("symdumpAtExit")); &closeLog(); &closeSQLDebug() if (&IsParam("SQLDebug")); @@ -204,6 +225,13 @@ sub IsChanConf { return 0; } + # should we use IsParam() externally where needed or hack it in + # here just in case? fix it later. + if (&IsParam($param)) { + &DEBUG("ICC: found '$param' option in main config file."); + return 1; + } + $chan ||= "_default"; my $old = $chan; @@ -276,11 +304,11 @@ 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."); } @@ -288,7 +316,7 @@ sub getChanConf { $c ||= $chan; $c ||= "_default"; $c = "_default" if ($c eq "*"); # fix! - my @c = grep /^$c$/i, keys %chanconf; + my @c = grep /^\Q$c\E$/i, keys %chanconf; if (@c) { if (0 and $c[0] ne $c) { @@ -301,6 +329,29 @@ sub getChanConf { return $chanconf{"_default"}{$param}; } +sub getChanConfDefault { + my($what, $default, $chan) = @_; + + $chan ||= "_default"; + + if (exists $param{$what}) { + if (!exists $cache{config}{$what}) { + &status("config ($chan): backward-compatible option: found param{$what} ($param{$what}) instead of chan option"); + $cache{config}{$what} = 1; + } + + return $param{$what}; + } + my $val = &getChanConf($what, $chan); + return $val if (defined $val); + + $param{$what} = $default; + &status("config ($chan): auto-setting param{$what} = $default"); + $cache{config}{$what} = 1; + return $default; +} + + ##### # Usage: &findChanConf($param); # About: Retrieve value for 'param' value from any chan. @@ -318,7 +369,6 @@ sub findChanConf { foreach (keys %{ $chanconf{$c} }) { next unless (/^$param$/); - &DEBUG("chanconf{$c}{$_} ..."); return $chanconf{$c}{$_}; } } @@ -329,19 +379,19 @@ sub findChanConf { sub showProc { my ($prefix) = $_[0] || ""; - if (!open(IN, "/proc/$$/status")) { - &ERROR("cannot open '/proc/$$/status'."); - return; - } - if ($^O eq "linux") { + if (!open(IN, "/proc/$$/status")) { + &ERROR("cannot open '/proc/$$/status'."); + return; + } + while () { $memusage = $1 if (/^VmSize:\s+(\d+) kB/); } 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 $$`; @@ -359,13 +409,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. YES YES YES"; + $str = "MEM:$prefix decreased by $delta KiB."; } &status($str); @@ -382,13 +432,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(); @@ -398,11 +441,11 @@ 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); @@ -412,7 +455,7 @@ sub setup { $param{tempDir} =~ s#\~/#$ENV{HOME}/#; - &status("Initial memory usage: $memusage kB"); + &status("Initial memory usage: $memusage KiB"); &status("-------------------------------------------------------"); } @@ -420,7 +463,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; @@ -437,7 +480,7 @@ sub setupConfig { if (! -d $param{tempDir}) { &status("making $param{tempDir}..."); - system("mkdir $param{tempDir}"); + mkdir $param{tempDir}, 0755; } # static scalar variables. @@ -448,7 +491,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; } @@ -459,18 +502,21 @@ sub startup { } sub shutdown { + my ($sig) = @_; # reverse order of &setup(). &status("--- shutdown called."); $ident ||= "blootbot"; # hack. - # 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(); + &sqlCloseDB(); &closeSHM($shm); # aswell. TODO: use this in &doExit? &closeLog(); } @@ -482,8 +528,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(); @@ -493,7 +541,7 @@ sub restart { &ircCheck(); # heh, evil! &DCCBroadcast("-HUP called.","m"); - &shutdown(); + &shutdown($sig); &loadConfig($bot_config_dir."/blootbot.config"); &reloadAllModules() if (&IsParam("DEBUG")); &setup(); @@ -509,9 +557,8 @@ sub loadConfig { my ($file) = @_; if (!open(FILE, $file)) { - &ERROR("FAILED loadConfig ($file): $!"); - &status("Please copy files/sample.config to files/blootbot.config"); - &status(" and edit files/blootbot.config, modify to tastes."); + &ERROR("Failed to read configuration file ($file): $!"); + &status("Please read the INSTALL file on how to install and setup this file."); exit 0; }