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