X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=src%2Fcore.pl;h=802e4c20a72da8c33dd51a4a3440f5ff4d42499d;hb=f7cae48a17d6decd0a9bd997188271daa0a885b1;hp=4caf49330df9aa9d7903ec8bbe7b0f30df03fdbb;hpb=9470a98f023bb0efa5569b87e825c281014bae14;p=infobot.git diff --git a/src/core.pl b/src/core.pl index 4caf493..802e4c2 100644 --- a/src/core.pl +++ b/src/core.pl @@ -7,29 +7,31 @@ use strict; -# dynamic scalar. MUST BE REDUCED IN SIZE!!! +# scalar. MUST BE REDUCED IN SIZE!!! ### TODO: reorder. use vars qw( - $answer $correction_plausible $talkchannel + $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 $bot_misc_dir $bot_pid $bot_base_dir $noreply - $bot_src_dir $conn $irc $learnok $nick $ident $no_syscall + $shm $host $msg $noreply $conn $irc $learnok $nick $ident $force_public_reply $addrchar $userHandle $addressedother $floodwho $chan $msgtime $server $firsttime $wingaterun - $flag_quit $msgType + $flag_quit $msgType $no_syscall $utime_userfile $wtime_userfile $ucount_userfile $utime_chanfile $wtime_chanfile $ucount_chanfile - $pubsize $pubcount $pubtime $pubsleep - $msgsize $msgcount $msgtime $msgsleep - $notsize $notcount $nottime $notsleep + $pubsize $pubcount $pubtime + $msgsize $msgcount $msgtime + $notsize $notcount $nottime + $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 @@ -47,7 +49,7 @@ $SIG{'__WARN__'} = 'doWarn'; $last{buflen} = 0; $last{say} = ""; $last{msg} = ""; -$userHandle = "default"; +$userHandle = "_default"; $wingaterun = time(); $firsttime = 1; $utime_userfile = 0; @@ -56,24 +58,46 @@ $ucount_userfile = 0; $utime_chanfile = 0; $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 = $msgsleep = 0; +$msgcount = 0; $pubtime = 0; $pubsize = 0; -$pubcount = $pubsleep = 0; +$pubcount = 0; $nottime = 0; $notsize = 0; -$notcount = $notsleep = 0; +$notcount = 0; ### -$bot_version = "blootbot cvs (20010214) -- $^O"; +$bot_release = "1.1.0"; +if ( -d "CVS" ) { + use POSIX qw(strftime); + $bot_release .= strftime(" cvs (%Y%m%d)", gmtime( (stat("CVS"))[9] ) ); +} +$bot_version = "blootbot $bot_release -- $^O"; $noreply = "NOREPLY"; ########## ### misc commands. ### +sub whatInterface { + if (!&IsParam("Interface") or $param{'Interface'} =~ /IRC/) { + return "IRC"; + } else { + return "CLI"; + } +} + sub doExit { my ($sig) = @_; @@ -89,18 +113,25 @@ sub doExit { &status("parent caught SIG$sig (pid $$).") if (defined $sig); &status("--- Start of quit."); + $ident ||= "blootbot"; # lame hack. + + &status("Memory Usage: $memusage KiB"); - &closeDCC(); &closePID(); - &seenFlush(); - &quit($param{'quitMsg'}) if (&whatInterface() =~ /IRC/); + &closeStats(); + # 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")); @@ -194,6 +225,15 @@ 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; if ($chan =~ tr/A-Z/a-z/) { &WARN("IsChanConf: lowercased chan. ($old)"); @@ -261,39 +301,97 @@ sub IsChanConf { # About: Retrieve value for 'param' value in current/default chan. # Return: scalar for success, undef for failure. sub getChanConf { - my($param,$chan) = @_; + my($param,$c) = @_; if (!defined $param) { - &WARN("param == NULL."); + &WARN("gCC: param == NULL."); return 0; } + # 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 /^\Q$c\E$/i, keys %chanconf; + + if (@c) { + if (0 and $c[0] ne $c) { + &WARN("c ne chan ($c[0] ne $chan)"); + } + return $chanconf{$c[0]}{$param}; + } + +# &DEBUG("gCC: returning _default... "); + return $chanconf{"_default"}{$param}; +} + +sub getChanConfDefault { + my($what, $default, $chan) = @_; + $chan ||= "_default"; - my @c = grep /^$chan$/i, keys %chanconf; - if (@c and $c[0] ne $chan) { - &WARN("c ne chan ($c[0] ne $chan)"); + 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); - return $chanconf{$c[0]}{$param} || $chanconf{"_default"}{$param}; + $param{$what} = $default; + &status("config ($chan): auto-setting param{$what} = $default"); + $cache{config}{$what} = 1; + return $default; } -sub showProc { - my ($prefix) = $_[0] || ""; - if (!open(IN, "/proc/$$/status")) { - &ERROR("cannot open '/proc/$$/status'."); - return; +##### +# Usage: &findChanConf($param); +# About: Retrieve value for 'param' value from any chan. +# Return: scalar for success, undef for failure. +sub findChanConf { + my($param) = @_; + + if (!defined $param) { + &WARN("param == NULL."); + return 0; } + my $c; + foreach $c (keys %chanconf) { + foreach (keys %{ $chanconf{$c} }) { + next unless (/^$param$/); + + return $chanconf{$c}{$_}; + } + } + + return; +} + +sub showProc { + my ($prefix) = $_[0] || ""; + 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 $$`; @@ -311,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); @@ -334,15 +432,8 @@ 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_misc_dir. "/blootbot.lang"); + &loadLang($bot_data_dir. "/blootbot.lang"); &loadIRCServers(); &readUserFile(); &readChanFile(); @@ -350,21 +441,29 @@ 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); $param{tempDir} =~ s#\~/#$ENV{HOME}/#; - &status("Initial memory usage: $memusage kB"); + &status("Initial memory usage: $memusage KiB"); + &status("-------------------------------------------------------"); } sub setupConfig { $param{'VERBOSITY'} = 1; - &loadConfig($bot_misc_dir."/blootbot.config"); + &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; @@ -381,18 +480,18 @@ sub setupConfig { if (! -d $param{tempDir}) { &status("making $param{tempDir}..."); - system("mkdir $param{tempDir}"); + mkdir $param{tempDir}, 0755; } # static scalar variables. - $file{utm} = "$bot_base_dir/$param{'ircUser'}.uptime"; - $file{PID} = "$bot_base_dir/$param{'ircUser'}.pid"; + $file{utm} = "$bot_state_dir/$param{'ircUser'}.uptime"; + $file{PID} = "$bot_run_dir/$param{'ircUser'}.pid"; } 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; } @@ -403,16 +502,21 @@ sub startup { } sub shutdown { + my ($sig) = @_; # reverse order of &setup(). - &DEBUG("shutdown called."); + &status("--- shutdown called."); + + $ident ||= "blootbot"; # hack. + + if (!&isFileUpdated("$bot_state_dir/blootbot.users", $wtime_userfile)) { + &writeUserFile() + } - # 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.chan", $wtime_chanfile)) { + &writeChanFile(); + } - &closeDB(); + &sqlCloseDB(); &closeSHM($shm); # aswell. TODO: use this in &doExit? &closeLog(); } @@ -424,9 +528,12 @@ sub restart { &status("--- $sig called."); ### crappy bug in Net::IRC? - if (!$conn->connected and time - $msgtime > 900) { - &status("reconnecting because of uncaught disconnect."); + 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(); ### return; } @@ -434,8 +541,8 @@ sub restart { &ircCheck(); # heh, evil! &DCCBroadcast("-HUP called.","m"); - &shutdown(); - &loadConfig($bot_misc_dir."/blootbot.config"); + &shutdown($sig); + &loadConfig($bot_config_dir."/blootbot.config"); &reloadAllModules() if (&IsParam("DEBUG")); &setup(); @@ -450,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; }