src/core.pl

   1 #
   2 #   core.pl: Important functions stuff...
   3 #    Author: dms
   4 #   Version: v0.4 (20000718)
   5 #   Created: 20000322
   6 #
   7
   8 use strict;
   9
  10 # scalar. MUST BE REDUCED IN SIZE!!!
  11 ### TODO: reorder.
  12 use vars qw(
  13         $bot_misc_dir $bot_pid $bot_base_dir $bot_src_dir
  14         $bot_data_dir $bot_config_dir $bot_state_dir $bot_run_dir
  15         $answer $correction_plausible $talkchannel $bot_release
  16         $statcount $memusage $user $memusageOld $bot_version $dbh
  17         $shm $host $msg $noreply $conn $irc $learnok $nick $ident
  18         $force_public_reply $addrchar $userHandle $addressedother
  19         $floodwho $chan $msgtime $server $firsttime $wingaterun
  20         $flag_quit $msgType $no_syscall
  21         $utime_userfile $wtime_userfile $ucount_userfile
  22         $utime_chanfile $wtime_chanfile $ucount_chanfile
  23         $pubsize $pubcount $pubtime
  24         $msgsize $msgcount $msgtime
  25         $notsize $notcount $nottime
  26         $running
  27 );
  28
  29 # array.
  30 use vars qw(@joinchan @ircServers @wingateBad @wingateNow @wingateCache
  31 );
  32
  33 ### hash. MUST BE REDUCED IN SIZE!!!
  34 #
  35 use vars qw(%count %netsplit %netsplitservers %flood %dcc %orig
  36             %nuh %talkWho %seen %floodwarn %param %dbh %ircPort
  37             %topic %moduleAge %last %time %mask %file
  38             %forked %chanconf %channels
  39 );
  40
  41 # Signals.
  42 $SIG{'HUP'}  = 'restart'; #  1.
  43 $SIG{'INT'}  = 'doExit';  #  2.
  44 $SIG{'KILL'} = 'doExit';  #  9. DOES NOT WORK. 'man perlipc' for details.
  45 $SIG{'TERM'} = 'doExit';  # 15.
  46 $SIG{'__WARN__'} = 'doWarn';
  47
  48 # initialize variables.
  49 $last{buflen}   = 0;
  50 $last{say}      = "";
  51 $last{msg}      = "";
  52 $userHandle     = "_default";
  53 $wingaterun     = time();
  54 $firsttime      = 1;
  55 $utime_userfile = 0;
  56 $wtime_userfile = 0;
  57 $ucount_userfile = 0;
  58 $utime_chanfile = 0;
  59 $wtime_chanfile = 0;
  60 $ucount_chanfile = 0;
  61 $running        = 0;
  62 ### more variables...
  63 $msgtime        = time();
  64 $msgsize        = 0;
  65 $msgcount       = 0;
  66 $pubtime        = 0;
  67 $pubsize        = 0;
  68 $pubcount       = 0;
  69 $nottime        = 0;
  70 $notsize        = 0;
  71 $notcount       = 0;
  72 ###
  73 if ( -d "CVS" ) {
  74     use POSIX qw(strftime);
  75     $bot_release        = strftime("cvs (%Y%m%d)", gmtime( (stat("CVS"))[9] ) );
  76 } else {
  77     $bot_release        = "1.0.10 (2001xxxx)";
  78 }
  79 $bot_version    = "blootbot $bot_release -- $^O";
  80 $noreply        = "NOREPLY";
  81
  82 ##########
  83 ### misc commands.
  84 ###
  85
  86 sub doExit {
  87     my ($sig)   = @_;
  88
  89     if (defined $flag_quit) {
  90         &WARN("doExit: quit already called.");
  91         return;
  92     }
  93     $flag_quit  = 1;
  94
  95     if (!defined $bot_pid) {    # independent.
  96         exit 0;
  97     } elsif ($bot_pid == $$) {  # parent.
  98         &status("parent caught SIG$sig (pid $$).") if (defined $sig);
  99
 100         &status("--- Start of quit.");
 101         $ident ||= "blootbot";  # lame hack.
 102
 103         &status("Memory Usage: $memusage KiB");
 104
 105         &closePID();
 106         &closeStats();
 107         # shutdown IRC and related components.
 108         if (&whatInterface() =~ /IRC/) {
 109             &closeDCC();
 110             &seenFlush();
 111             &quit($param{'quitMsg'});
 112         }
 113         &writeUserFile();
 114         &writeChanFile();
 115         &uptimeWriteFile()      if (&IsChanConf("uptime"));
 116         &sqlCloseDB();
 117         &closeSHM($shm);
 118         &dumpallvars()          if (&IsParam("dumpvarsAtExit"));
 119         &symdumpAll()           if (&IsParam("symdumpAtExit"));
 120         &closeLog();
 121         &closeSQLDebug()        if (&IsParam("SQLDebug"));
 122
 123         &status("--- QUIT.");
 124     } else {                                    # child.
 125         &status("child caught SIG$sig (pid $$).");
 126     }
 127
 128     exit 0;
 129 }
 130
 131 sub doWarn {
 132     $SIG{__WARN__} = sub { warn $_[0]; };
 133
 134     foreach (@_) {
 135         &WARN("PERL: $_");
 136     }
 137
 138     $SIG{__WARN__} = 'doWarn';  # ???
 139 }
 140
 141 # Usage: &IsParam($param);
 142 # blootbot.config specific.
 143 sub IsParam {
 144     my $param = $_[0];
 145
 146     return 0 unless (defined $param);
 147     return 0 unless (exists $param{$param});
 148     return 0 unless ($param{$param});
 149     return 0 if $param{$param} =~ /^false$/i;
 150     return 1;
 151 }
 152
 153 #####
 154 #  Usage: &ChanConfList($param)
 155 #  About: gets channels with 'param' enabled. (!!!)
 156 # Return: array of channels
 157 sub ChanConfList {
 158     my $param   = $_[0];
 159     return unless (defined $param);
 160     my %chan    = &getChanConfList($param);
 161
 162     if (exists $chan{_default}) {
 163         return keys %chanconf;
 164     } else {
 165         return keys %chan;
 166     }
 167 }
 168
 169 #####
 170 #  Usage: &getChanConfList($param)
 171 #  About: gets channels with 'param' enabled, internal use only.
 172 # Return: hash of channels
 173 sub getChanConfList {
 174     my $param   = $_[0];
 175     my %chan;
 176
 177     return unless (defined $param);
 178
 179     foreach (keys %chanconf) {
 180         my $chan        = $_;
 181 #       &DEBUG("chan => $chan");
 182         my @array       = grep /^$param$/, keys %{ $chanconf{$chan} };
 183
 184         next unless (scalar @array);
 185
 186         if (scalar @array > 1) {
 187             &WARN("multiple items found?");
 188         }
 189
 190         if ($array[0] eq "0") {
 191             $chan{$chan}        = -1;
 192         } else {
 193             $chan{$chan}        =  1;
 194         }
 195     }
 196
 197     return %chan;
 198 }
 199
 200 #####
 201 #  Usage: &IsChanConf($param);
 202 #  About: Check for 'param' on the basis of channel config.
 203 # Return: 1 for enabled, 0 for passive disable, -1 for active disable.
 204 sub IsChanConf {
 205     my($param)  = shift;
 206     my $debug   = 0;    # knocked tons of bugs with this! :)
 207
 208     if (!defined $param) {
 209         &WARN("IsChanConf: param == NULL.");
 210         return 0;
 211     }
 212
 213     # should we use IsParam() externally where needed or hack it in
 214     # here just in case? fix it later.
 215     if (&IsParam($param)) {
 216         &DEBUG("ICC: found '$param' option in main config file.");
 217         return 1;
 218     }
 219
 220     $chan       ||= "_default";
 221
 222     my $old = $chan;
 223     if ($chan =~ tr/A-Z/a-z/) {
 224         &WARN("IsChanConf: lowercased chan. ($old)");
 225     }
 226
 227     ### TODO: VERBOSITY on how chanconf returned 1 or 0 or -1.
 228     my %chan    = &getChanConfList($param);
 229     my $nomatch = 0;
 230     if (!defined $msgType) {
 231         $nomatch++;
 232     } else {
 233         $nomatch++ if ($msgType eq "");
 234         $nomatch++ unless ($msgType =~ /^(public|private)$/i);
 235     }
 236
 237 ### debug purposes only.
 238 #    &DEBUG("param => $param, msgType => $msgType.");
 239 #    foreach (keys %chan) {
 240 #       &DEBUG("   $_ => $chan{$_}");
 241 #    }
 242
 243     if ($nomatch) {
 244         if ($chan{$chan}) {
 245             &DEBUG("ICC: other: $chan{$chan} (_default/$param)") if ($debug);
 246         } elsif ($chan{_default}) {
 247             &DEBUG("ICC: other: $chan{_default} (_default/$param)") if ($debug);
 248         } else {
 249             &DEBUG("ICC: other: 0 ($param)") if ($debug);
 250         }
 251
 252         return $chan{$chan} || $chan{_default} || 0;
 253     }
 254
 255     if ($msgType eq "public") {
 256         if ($chan{$chan}) {
 257             &DEBUG("ICC: public: $chan{$chan} ($chan/$param)") if ($debug);
 258         } elsif ($chan{_default}) {
 259             &DEBUG("ICC: public: $chan{_default} (_default/$param)") if ($debug);
 260         } else {
 261             &DEBUG("ICC: public: 0 ($param)") if ($debug);
 262         }
 263
 264         return $chan{$chan} || $chan{_default} || 0;
 265     }
 266
 267     if ($msgType eq "private") {
 268         if ($chan{_default}) {
 269             &DEBUG("ICC: private: $chan{_default} (_default/$param)") if ($debug);
 270         } elsif ($chan{$chan}) {
 271             &DEBUG("ICC: private: $chan{$chan} ($chan/$param) (hack)") if ($debug);
 272         } else {
 273             &DEBUG("ICC: private: 0 ($param)") if ($debug);
 274         }
 275
 276         return $chan{$chan} || $chan{_default} || 0;
 277     }
 278
 279     &DEBUG("ICC: no-match: 0/$param (msgType = $msgType)");
 280
 281     return 0;
 282 }
 283
 284 #####
 285 #  Usage: &getChanConf($param);
 286 #  About: Retrieve value for 'param' value in current/default chan.
 287 # Return: scalar for success, undef for failure.
 288 sub getChanConf {
 289     my($param,$c)       = @_;
 290
 291     if (!defined $param) {
 292         &WARN("gCC: param == NULL.");
 293         return 0;
 294     }
 295
 296     # this looks evil...
 297     if (0 and !defined $chan) {
 298         &DEBUG("gCC: ok !chan... doing _default instead.");
 299     }
 300
 301     $c          ||= $chan;
 302     $c          ||= "_default";
 303     $c          = "_default" if ($c eq "*");    # fix!
 304     my @c       = grep /^\Q$c\E$/i, keys %chanconf;
 305
 306     if (@c) {
 307         if (0 and $c[0] ne $c) {
 308             &WARN("c ne chan ($c[0] ne $chan)");
 309         }
 310         return $chanconf{$c[0]}{$param};
 311     }
 312
 313 #    &DEBUG("gCC: returning _default... ");
 314     return $chanconf{"_default"}{$param};
 315 }
 316
 317 sub getChanConfDefault {
 318     my($what, $default, $chan) = @_;
 319
 320     $chan       ||= "_default";
 321
 322     if (exists $param{$what}) {
 323         if (!exists $cache{config}{$what}) {
 324             &status("config ($chan): backward-compatible option: found param{$what} ($param{$what}) instead");
 325             $cache{config}{$what} = 1;
 326         }
 327
 328         return $param{$what};
 329     }
 330     my $val = &getChanConf($what, $chan);
 331     return $val if (defined $val);
 332
 333     $param{$what}       = $default;
 334     &status("config ($chan): auto-setting param{$what} = $default");
 335     $cache{config}{$what} = 1;
 336     return $default;
 337 }
 338
 339
 340 #####
 341 #  Usage: &findChanConf($param);
 342 #  About: Retrieve value for 'param' value from any chan.
 343 # Return: scalar for success, undef for failure.
 344 sub findChanConf {
 345     my($param)  = @_;
 346
 347     if (!defined $param) {
 348         &WARN("param == NULL.");
 349         return 0;
 350     }
 351
 352     my $c;
 353     foreach $c (keys %chanconf) {
 354         foreach (keys %{ $chanconf{$c} }) {
 355             next unless (/^$param$/);
 356
 357             return $chanconf{$c}{$_};
 358         }
 359     }
 360
 361     return;
 362 }
 363
 364 sub showProc {
 365     my ($prefix) = $_[0] || "";
 366
 367     if ($^O eq "linux") {
 368         if (!open(IN, "/proc/$$/status")) {
 369             &ERROR("cannot open '/proc/$$/status'.");
 370             return;
 371         }
 372
 373         while (<IN>) {
 374             $memusage = $1 if (/^VmSize:\s+(\d+) kB/);
 375         }
 376         close IN;
 377
 378     } elsif ($^O eq "netbsd") {
 379         $memusage = int( (stat "/proc/$$/mem")[7]/1024 );
 380
 381     } elsif ($^O =~ /^(free|open)bsd$/) {
 382         my @info  = split /\s+/, `/bin/ps -l -p $$`;
 383         $memusage = $info[20];
 384
 385     } else {
 386         $memusage = "UNKNOWN";
 387         return;
 388     }
 389
 390     if (defined $memusageOld and &IsParam("DEBUG")) {
 391         # it's always going to be increase.
 392         my $delta = $memusage - $memusageOld;
 393         my $str;
 394         if ($delta == 0) {
 395             return;
 396         } elsif ($delta > 500) {
 397             $str = "MEM:$prefix increased by $delta KiB. (total: $memusage KiB)";
 398         } elsif ($delta > 0) {
 399             $str = "MEM:$prefix increased by $delta KiB";
 400         } else {        # delta < 0.
 401             $delta = -$delta;
 402             # never knew RSS could decrease, probably Size can't?
 403             $str = "MEM:$prefix decreased by $delta KiB.";
 404         }
 405
 406         &status($str);
 407     }
 408     $memusageOld = $memusage;
 409 }
 410
 411 ######
 412 ###### SETUP
 413 ######
 414
 415 sub setup {
 416     &showProc(" (\&openLog before)");
 417     &openLog();         # write, append.
 418     &status("--- Started logging.");
 419
 420     # read.
 421     &loadLang($bot_data_dir. "/blootbot.lang");
 422     &loadIRCServers();
 423     &readUserFile();
 424     &readChanFile();
 425     &loadMyModulesNow();        # must be after chan file.
 426
 427     $shm = &openSHM();
 428     &openSQLDebug()     if (&IsParam("SQLDebug"));
 429     &sqlOpenDB($param{'DBName'}, $param{'DBType'}, $param{'SQLUser'},
 430         $param{'SQLPass'});
 431     &checkTables();
 432
 433     &status("Setup: ". &countKeys("factoids") ." factoids.");
 434     &getChanConfDefault("sendPrivateLimitLines", 3);
 435     &getChanConfDefault("sendPrivateLimitBytes", 1000);
 436     &getChanConfDefault("sendPublicLimitLines", 3);
 437     &getChanConfDefault("sendPublicLimitBytes", 1000);
 438     &getChanConfDefault("sendNoticeLimitLines", 3);
 439     &getChanConfDefault("sendNoticeLimitBytes", 1000);
 440
 441     $param{tempDir} =~ s#\~/#$ENV{HOME}/#;
 442
 443     &status("Initial memory usage: $memusage KiB");
 444     &status("-------------------------------------------------------");
 445 }
 446
 447 sub setupConfig {
 448     $param{'VERBOSITY'} = 1;
 449     &loadConfig($bot_config_dir."/blootbot.config");
 450
 451     foreach ( qw(ircNick ircUser ircName DBType tempDir) ) {
 452         next if &IsParam($_);
 453         &ERROR("Parameter $_ has not been defined.");
 454         exit 1;
 455     }
 456
 457     if ($param{tempDir} =~ s#\~/#$ENV{HOME}/#) {
 458         &VERB("Fixing up tempDir.",2);
 459     }
 460
 461     if ($param{tempDir} =~ /~/) {
 462         &ERROR("parameter tempDir still contains tilde.");
 463         exit 1;
 464     }
 465
 466     if (! -d $param{tempDir}) {
 467         &status("making $param{tempDir}...");
 468         mkdir $param{tempDir}, 0755;
 469     }
 470
 471     # static scalar variables.
 472     $file{utm}  = "$bot_state_dir/$param{'ircUser'}.uptime";
 473     $file{PID}  = "$bot_run_dir/$param{'ircUser'}.pid";
 474 }
 475
 476 sub startup {
 477     if (&IsParam("DEBUG")) {
 478         &status("enabling debug diagnostics.");
 479         ### I thought disabling this reduced memory usage by 1000 KiB.
 480         use diagnostics;
 481     }
 482
 483     $count{'Question'}  = 0;
 484     $count{'Update'}    = 0;
 485     $count{'Dunno'}     = 0;
 486     $count{'Moron'}     = 0;
 487 }
 488
 489 sub shutdown {
 490     my ($sig) = @_;
 491     # reverse order of &setup().
 492     &status("--- shutdown called.");
 493
 494     $ident ||=  "blootbot";     # hack.
 495
 496     if (!&isFileUpdated("$bot_state_dir/blootbot.users", $wtime_userfile)) {
 497         &writeUserFile()
 498     }
 499
 500     if (!&isFileUpdated("$bot_state_dir/blootbot.chan", $wtime_chanfile)) {
 501         &writeChanFile();
 502     }
 503
 504     &sqlCloseDB();
 505     &closeSHM($shm);    # aswell. TODO: use this in &doExit?
 506     &closeLog();
 507 }
 508
 509 sub restart {
 510     my ($sig) = @_;
 511
 512     if ($$ == $bot_pid) {
 513         &status("--- $sig called.");
 514
 515         ### crappy bug in Net::IRC?
 516         my $delta = time() - $msgtime;
 517         &DEBUG("restart: dtime = $delta");
 518         if (!$conn->connected or time() - $msgtime > 900) {
 519             &status("reconnecting because of uncaught disconnect \@ ".scalar(gmtime) );
 520 ###         $irc->start;
 521             &clearIRCVars();
 522             $conn->connect();
 523 ###         return;
 524         }
 525
 526         &ircCheck();    # heh, evil!
 527
 528         &DCCBroadcast("-HUP called.","m");
 529         &shutdown($sig);
 530         &loadConfig($bot_config_dir."/blootbot.config");
 531         &reloadAllModules() if (&IsParam("DEBUG"));
 532         &setup();
 533
 534         &status("--- End of $sig.");
 535     } else {
 536         &status("$sig called; ignoring restart.");
 537     }
 538 }
 539
 540 # File: Configuration.
 541 sub loadConfig {
 542     my ($file) = @_;
 543
 544     if (!open(FILE, $file)) {
 545         &ERROR("Failed to read configuration file ($file): $!");
 546         &status("Please read the INSTALL file on how to install and setup this file.");
 547         exit 0;
 548     }
 549
 550     my $count = 0;
 551     while (<FILE>) {
 552         chomp;
 553         next if /^\s*\#/;
 554         next unless /\S/;
 555         my ($set,$key,$val) = split(/\s+/, $_, 3);
 556
 557         if ($set ne "set") {
 558             &status("loadConfig: invalid line '$_'.");
 559             next;
 560         }
 561
 562         # perform variable interpolation
 563         $val =~ s/(\$(\w+))/$param{$2}/g;
 564
 565         $param{$key} = $val;
 566
 567         ++$count;
 568     }
 569     close FILE;
 570
 571     $file =~ s/^.*\///;
 572     &status("Loaded config $file ($count items)");
 573 }
 574
 575 1;