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