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