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