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         &closeDB();
  89         &closeSHM($shm);
  90         &dumpallvars()          if (&IsParam("dumpvarsAtExit"));
  91         &closeLog();
  92         &closeSQLDebug()        if (&IsParam("SQLDebug"));
  93
  94         &status("--- QUIT.");
  95     } else {                                    # child.
  96         &status("child caught SIG$sig (pid $$).");
  97     }
  98
  99     exit 0;
 100 }
 101
 102 sub doWarn {
 103     $SIG{__WARN__} = sub { warn $_[0]; };
 104
 105     foreach (@_) {
 106         &WARN("PERL: $_");
 107     }
 108
 109     $SIG{__WARN__} = 'doWarn';  # ???
 110 }
 111
 112 # Usage: &IsParam($param);
 113 # blootbot.config specific.
 114 sub IsParam {
 115     my $param = $_[0];
 116
 117     return 0 unless (defined $param);
 118     return 0 unless (exists $param{$param});
 119     return 0 unless ($param{$param});
 120     return 0 if $param{$param} =~ /^false$/i;
 121     return 1;
 122 }
 123
 124 #####
 125 #  Usage: &ChanConfList($param)
 126 #  About: gets channels with 'param' enabled. (!!!)
 127 # Return: array of channels
 128 sub ChanConfList {
 129     my $param   = $_[0];
 130     return unless (defined $param);
 131     my %chan    = &getChanConfList($param);
 132
 133     # what if we have it set on _default and a few channels with
 134     # negative set? perhaps we should disable -blah settings to remove
 135     # this mess.
 136
 137     if (exists $chan{_default}) {
 138         return keys %chanconf;
 139     } else {
 140         ### TODO: -option is included aswell though.
 141         return keys %chan;
 142     }
 143 }
 144
 145 #####
 146 #  Usage: &getChanConfList($param)
 147 #  About: gets channels with 'param' enabled, internal use only.
 148 # Return: hash of channels
 149 sub getChanConfList {
 150     my $param   = $_[0];
 151     my %chan;
 152
 153     return unless (defined $param);
 154
 155     foreach (keys %chanconf) {
 156         my $chan        = $_;
 157 #       &DEBUG("chan => $chan");
 158         my @array       = grep /^$param$/, keys %{ $chanconf{$chan} };
 159
 160         next unless (scalar @array);
 161
 162         if (scalar @array > 1) {
 163             &WARN("multiple items found?");
 164         }
 165
 166         if ($array[0] eq "0") {
 167             $chan{$chan}        = -1;
 168         } else {
 169             $chan{$chan}        =  1;
 170         }
 171     }
 172
 173     return %chan;
 174 }
 175
 176 #####
 177 #  Usage: &IsChanConf($param);
 178 #  About: Check for 'param' on the basis of channel config.
 179 # Return: 1 for enabled, 0 for passive disable, -1 for active disable.
 180 sub IsChanConf {
 181     my($param)  = shift;
 182
 183     if (!defined $param) {
 184         &WARN("param == NULL.");
 185         return 0;
 186     }
 187
 188     ### TODO: VERBOSITY on how chanconf returned 1 or 0 or -1.
 189     my %chan    = &getChanConfList($param);
 190     if (!defined $msgType) {
 191         return $chan{_default} || 0;
 192     }
 193
 194     if ($msgType eq "public") {
 195         return $chan{lc $chan} || $chan{_default} || 0;
 196     }
 197
 198     if ($msgType eq "private") {
 199         return $chan{_default} || 0;
 200     }
 201
 202 ### debug purposes only.
 203 #    &DEBUG("param => $param, msgType => $msgType.");
 204 #    foreach (keys %chan) {
 205 #       &DEBUG("   $_ => $chan{$_}");
 206 #    }
 207
 208     return 0;
 209 }
 210
 211 #####
 212 #  Usage: &getChanConf($param);
 213 #  About: Retrieve value for 'param' value in current/default chan.
 214 # Return: scalar for success, undef for failure.
 215 sub getChanConf {
 216     my($param,$chan)    = @_;
 217
 218     if (!defined $param) {
 219         &WARN("param == NULL.");
 220         return 0;
 221     }
 222
 223     $chan       ||= "_default";
 224     my @c       = grep /^$chan$/i, keys %chanconf;
 225
 226     if (@c and $c[0] ne $chan) {
 227         &WARN("c ne chan ($c[0] ne $chan)");
 228     }
 229
 230     return $chanconf{$c[0] || "_default"}{$param};
 231 }
 232
 233 sub showProc {
 234     my ($prefix) = $_[0] || "";
 235
 236     if (!open(IN, "/proc/$$/status")) {
 237         &ERROR("cannot open '/proc/$$/status'.");
 238         return;
 239     }
 240
 241     if ($^O eq "linux") {
 242         while (<IN>) {
 243             $memusage = $1 if (/^VmSize:\s+(\d+) kB/);
 244         }
 245         close IN;
 246
 247         if (defined $memusageOld and &IsParam("DEBUG")) {
 248             # it's always going to be increase.
 249             my $delta = $memusage - $memusageOld;
 250             my $str;
 251             if ($delta == 0) {
 252                 return;
 253             } elsif ($delta > 500) {
 254                 $str = "MEM:$prefix increased by $delta kB. (total: $memusage kB)";
 255             } elsif ($delta > 0) {
 256                 $str = "MEM:$prefix increased by $delta kB";
 257             } else {    # delta < 0.
 258                 $delta = -$delta;
 259                 # never knew RSS could decrease, probably Size can't?
 260                 $str = "MEM:$prefix decreased by $delta kB. YES YES YES";
 261             }
 262
 263             &status($str);
 264         }
 265         $memusageOld = $memusage;
 266     } else {
 267         $memusage = "UNKNOWN";
 268     }
 269     ### TODO: FreeBSD/*BSD support.
 270 }
 271
 272 ######
 273 ###### SETUP
 274 ######
 275
 276 sub setup {
 277     &showProc(" (\&openLog before)");
 278     &openLog();         # write, append.
 279     &status("--- Started logging.");
 280
 281     foreach ("debian") {
 282         my $dir = "$bot_base_dir/$_/";
 283         next if ( -d $dir);
 284         &status("Making dir $_");
 285         mkdir $dir, 0755;
 286     }
 287
 288     # read.
 289     &loadLang($bot_misc_dir.            "/blootbot.lang");
 290     &loadIRCServers();
 291     &readUserFile();
 292     &readChanFile();
 293     &loadMyModulesNow();        # must be after chan file.
 294
 295     $shm = &openSHM();
 296     &openSQLDebug()     if (&IsParam("SQLDebug"));
 297     &openDB($param{'DBName'}, $param{'SQLUser'}, $param{'SQLPass'});
 298
 299     &status("Setup: ". &countKeys("factoids") ." factoids.");
 300
 301     $param{tempDir} =~ s#\~/#$ENV{HOME}/#;
 302
 303     &status("Initial memory usage: $memusage kB");
 304 }
 305
 306 sub setupConfig {
 307     $param{'VERBOSITY'} = 1;
 308     &loadConfig($bot_misc_dir."/blootbot.config");
 309
 310     foreach ("ircNick", "ircUser", "ircName", "DBType", "tempDir") {
 311         next if &IsParam($_);
 312         &ERROR("Parameter $_ has not been defined.");
 313         exit 1;
 314     }
 315
 316     if ($param{tempDir} =~ s#\~/#$ENV{HOME}/#) {
 317         &VERB("Fixing up tempDir.",2);
 318     }
 319
 320     if ($param{tempDir} =~ /~/) {
 321         &ERROR("parameter tempDir still contains tilde.");
 322         exit 1;
 323     }
 324
 325     if (! -d $param{tempDir}) {
 326         &status("making $param{tempDir}...");
 327         system("mkdir $param{tempDir}");
 328     }
 329
 330     # static scalar variables.
 331     $file{utm}  = "$bot_base_dir/$param{'ircUser'}.uptime";
 332     $file{PID}  = "$bot_base_dir/$param{'ircUser'}.pid";
 333 }
 334
 335 sub startup {
 336     if (&IsParam("DEBUG")) {
 337         &status("enabling debug diagnostics.");
 338         ### I thought disabling this reduced memory usage by 1000 kB.
 339         use diagnostics;
 340     }
 341
 342     $count{'Question'}  = 0;
 343     $count{'Update'}    = 0;
 344     $count{'Dunno'}     = 0;
 345     $count{'Moron'}     = 0;
 346 }
 347
 348 sub shutdown {
 349     # reverse order of &setup().
 350     &DEBUG("shutdown called.");
 351
 352     &closeDB();
 353     &closeSHM($shm);    # aswell. TODO: use this in &doExit?
 354     &closeLog();
 355 }
 356
 357 sub restart {
 358     my ($sig) = @_;
 359
 360     if ($$ == $bot_pid) {
 361         &status("--- $sig called.");
 362
 363         ### crappy bug in Net::IRC?
 364         if (!$conn->connected and time - $msgtime > 900) {
 365             &status("reconnecting because of uncaught disconnect.");
 366 ##          $irc->start;
 367             $conn->connect();
 368             return;
 369         }
 370
 371         &DCCBroadcast("-HUP called.","m");
 372         &shutdown();
 373         &loadConfig($bot_misc_dir."/blootbot.config");
 374         &reloadAllModules() if (&IsParam("DEBUG"));
 375         &setup();
 376
 377         &status("--- End of $sig.");
 378     } else {
 379         &status("$sig called; ignoring restart.");
 380     }
 381 }
 382
 383 # File: Configuration.
 384 sub loadConfig {
 385     my ($file) = @_;
 386
 387     if (!open(FILE, $file)) {
 388         &ERROR("FAILED loadConfig ($file): $!");
 389         &status("Please copy files/sample.config to files/blootbot.config");
 390         &status("  and edit files/blootbot.config, modify to tastes.");
 391         exit 0;
 392     }
 393
 394     my $count = 0;
 395     while (<FILE>) {
 396         chomp;
 397         next if /^\s*\#/;
 398         next unless /\S/;
 399         my ($set,$key,$val) = split(/\s+/, $_, 3);
 400
 401         if ($set ne "set") {
 402             &status("loadConfig: invalid line '$_'.");
 403             next;
 404         }
 405
 406         # perform variable interpolation
 407         $val =~ s/(\$(\w+))/$param{$2}/g;
 408
 409         $param{$key} = $val;
 410
 411         ++$count;
 412     }
 413     close FILE;
 414
 415     $file =~ s/^.*\///;
 416     &status("Loaded config $file ($count items)");
 417 }
 418
 419 1;