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