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