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