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 );
  20
  21 # dynamic hash.
  22 use vars qw(@joinchan @ircServers @wingateBad @wingateNow @wingateCache
  23 );
  24
  25 # dynamic hash. MUST BE REDUCED IN SIZE!!!
  26 use vars qw(%count %netsplit %netsplitservers %flood %dcc %orig
  27             %nuh %talkWho %seen %floodwarn %param %dbh %ircPort %userList
  28             %jointime %topic %joinverb %moduleAge %last %time %mask %file
  29             %forked %pid %fork
  30 );
  31
  32 # Signals.
  33 $SIG{'HUP'}  = 'restart'; #  1.
  34 $SIG{'INT'}  = 'doExit';  #  2.
  35 $SIG{'KILL'} = 'doExit';  #  9. DOES NOT WORK. 'man perlipc' for details.
  36 $SIG{'TERM'} = 'doExit';  # 15.
  37 $SIG{'__WARN__'} = 'doWarn';
  38
  39 # initialize variables.
  40 $last{buflen}   = 0;
  41 $last{say}      = "";
  42 $last{msg}      = "";
  43 $userHandle     = "default";
  44 $msgtime        = time();
  45 $wingaterun     = time();
  46 $firsttime      = 1;
  47
  48 ### CHANGE TO STATIC.
  49 $bot_version = "blootbot cvs (20001212) -- $^O";
  50 $noreply        = "NOREPLY";
  51
  52 ##########
  53 ### misc commands.
  54 ###
  55
  56 sub doExit {
  57     my ($sig) = @_;
  58
  59     if (!defined $bot_pid) {    # independent.
  60         exit 0;
  61     } elsif ($bot_pid == $$) {  # parent.
  62         &status("parent caught SIG$sig (pid $$).") if (defined $sig);
  63
  64         &status("--- Start of quit.");
  65
  66         my $type;
  67         &closeDCC();
  68         &closePID();
  69         &seenFlush();
  70         &quit($param{'quitMsg'}) if (&whatInterface() =~ /IRC/);
  71         &uptimeWriteFile();
  72         &closeDB();
  73         &closeSHM($shm);
  74         &dumpallvars()  if (&IsParam("dumpvarsAtExit"));
  75         &closeLog();
  76         &closeSQLDebug()        if (&IsParam("SQLDebug"));
  77         &status("--- QUIT.");
  78     } else {                                    # child.
  79         &status("child caught SIG$sig (pid $$).");
  80     }
  81
  82     exit 0;
  83 }
  84
  85 sub doWarn {
  86     $SIG{__WARN__} = sub { warn $_[0]; };
  87
  88     foreach (@_) {
  89         &WARN("PERL: $_");
  90     }
  91
  92     $SIG{__WARN__} = 'doWarn';  # ???
  93 }
  94
  95 # Usage: &IsParam($param);
  96 sub IsParam {
  97     my $param = $_[0];
  98
  99     return 0 unless (defined $param);
 100     return 0 unless (exists $param{$param});
 101     return 0 unless ($param{$param});
 102     return 0 if $param{$param} =~ /^false$/i;
 103     return 1;
 104 }
 105
 106 sub showProc {
 107     my ($prefix) = $_[0] || "";
 108
 109     if (!open(IN, "/proc/$$/status")) {
 110         &ERROR("cannot open '/proc/$$/status'.");
 111         return;
 112     }
 113
 114     if ($^O eq "linux") {
 115         while (<IN>) {
 116             $memusage = $1 if (/^VmSize:\s+(\d+) kB/);
 117         }
 118         close IN;
 119
 120         if (defined $memusageOld and &IsParam("DEBUG")) {
 121             # it's always going to be increase.
 122             my $delta = $memusage - $memusageOld;
 123             my $str;
 124             if ($delta == 0) {
 125                 return;
 126             } elsif ($delta > 500) {
 127                 $str = "MEM:$prefix increased by $delta kB. (total: $memusage kB)";
 128             } elsif ($delta > 0) {
 129                 $str = "MEM:$prefix increased by $delta kB";
 130             } else {    # delta < 0.
 131                 $delta = -$delta;
 132                 # never knew RSS could decrease, probably Size can't?
 133                 $str = "MEM:$prefix decreased by $delta kB. YES YES YES";
 134             }
 135
 136             &status($str);
 137             &DCCBroadcast($str) if (&whatInterface() =~ /IRC/ &&
 138                 grep(/Irc.pl/, keys %moduleAge));
 139         }
 140         $memusageOld = $memusage;
 141     } else {
 142         $memusage = "UNKNOWN";
 143     }
 144     ### TODO: FreeBSD/*BSD support.
 145 }
 146
 147 ######
 148 ###### SETUP
 149 ######
 150
 151 sub setup {
 152     &showProc(" (\&openLog before)");
 153     &openLog();         # write, append.
 154     &status("--- Started logging.");
 155
 156     foreach ("debian") {
 157         my $dir = "$bot_base_dir/$_/";
 158         next if ( -d $dir);
 159         &status("Making dir $_");
 160         mkdir $dir, 0755;
 161     }
 162
 163     # read.
 164     &loadIgnore($bot_misc_dir.          "/blootbot.ignore");
 165     &loadLang($bot_misc_dir.            "/blootbot.lang");
 166     &loadIRCServers($bot_misc_dir.      "/ircII.servers");
 167     &loadUsers($bot_misc_dir.           "/blootbot.users");
 168     if (&IsParam("WIP")) {
 169         require "src/UserFile.pl";
 170         &NEWloadUsers($bot_misc_dir."/blootbot.users_NEW");
 171         &closePID();
 172         &closeLog();
 173         exit 0;
 174     }
 175
 176     $shm = &openSHM();
 177     &openSQLDebug()     if (&IsParam("SQLDebug"));
 178     &openDB($param{'DBName'}, $param{'SQLUser'}, $param{'SQLPass'});
 179
 180     &status("Setup: ". &countKeys("factoids") ." factoids.");
 181
 182     $param{tempDir} =~ s#\~/#$ENV{HOME}/#;
 183
 184     &status("Initial memory usage: $memusage kB");
 185 }
 186
 187 sub setupConfig {
 188     $param{'VERBOSITY'} = 1;
 189     &loadConfig($bot_misc_dir."/blootbot.config");
 190     if (&IsParam("WIP")) {
 191         require "src/Config.pl";
 192         &NEWloadConfig();
 193     }
 194
 195     foreach ("ircNick", "ircUser", "ircName", "DBType", "tempDir") {
 196         next if &IsParam($_);
 197         &ERROR("Parameter $_ has not been defined.");
 198         exit 1;
 199     }
 200
 201     if ($param{tempDir} =~ s#\~/#$ENV{HOME}/#) {
 202         &status("Fixing up tempDir.");
 203     }
 204
 205     if ($param{tempDir} =~ /~/) {
 206         &ERROR("parameter tempDir still contains tilde.");
 207         exit 1;
 208     }
 209
 210     if (! -d $param{tempDir}) {
 211         &status("making $param{tempDir}...");
 212         system("mkdir $param{tempDir}");
 213     }
 214
 215     # static scalar variables.
 216     $file{utm}  = "$bot_base_dir/$param{'ircUser'}.uptime";
 217     $file{PID}  = "$bot_base_dir/$param{'ircUser'}.pid";
 218 }
 219
 220 sub startup {
 221     if (&IsParam("DEBUG")) {
 222         &status("enabling debug diagnostics.");
 223         ### I thought disabling this reduced memory usage by 1000 kB.
 224         use diagnostics;
 225     }
 226
 227     $count{'Question'}  = 0;
 228     $count{'Update'}    = 0;
 229     $count{'Dunno'}     = 0;
 230
 231     &loadMyModulesNow();
 232 }
 233
 234 sub shutdown {
 235     # reverse order of &setup().
 236     &DEBUG("shutdown called.");
 237
 238     &closeDB();
 239     &closeSHM($shm);    # aswell. TODO: use this in &doExit?
 240     &closeLog();
 241 }
 242
 243 sub restart {
 244     my ($sig) = @_;
 245
 246     &DEBUG(" forked => ".scalar(keys %forked) );
 247     &DEBUG(" fork   => ".scalar(keys %fork) );
 248     &DEBUG(" pid    => ".scalar(keys %pid) );
 249
 250     if ($$ == $bot_pid) {
 251         &status("--- $sig called.");
 252
 253         ### crappy bug in Net::IRC?
 254         if (!$conn->connected and time - $msgtime > 900) {
 255             &status("reconnecting because of uncaught disconnect.");
 256 ##          $irc->start;
 257             $conn->connect();
 258             return;
 259         }
 260
 261         &shutdown();
 262         &loadConfig($bot_misc_dir."/blootbot.config");
 263         &reloadAllModules() if (&IsParam("DEBUG"));
 264         &setup();
 265
 266         &status("--- End of $sig.");
 267     } else {
 268         &status("$sig called; ignoring restart.");
 269     }
 270 }
 271
 272 # File: Configuration.
 273 sub loadConfig {
 274     my ($file) = @_;
 275
 276     if (!open(FILE, $file)) {
 277         &ERROR("FAILED loadConfig ($file): $!");
 278         &status("Please copy files/sample.config to files/blootbot.config");
 279         &status("  and edit files/blootbot.config, modify to tastes.");
 280         exit 0;
 281     }
 282
 283     my $count = 0;
 284     while (<FILE>) {
 285         chomp;
 286         next if /^\s*\#/;
 287         next unless /\S/;
 288         my ($set,$key,$val) = split(/\s+/, $_, 3);
 289
 290         if ($set ne "set") {
 291             &status("loadConfig: invalid line '$_'.");
 292             next;
 293         }
 294
 295         # perform variable interpolation
 296         $val =~ s/(\$(\w+))/$param{$2}/g;
 297
 298         $param{$key} = $val;
 299
 300         ++$count;
 301     }
 302     close FILE;
 303
 304     $file =~ s/^.*\///;
 305     &status("Loaded config $file ($count items)");
 306 }
 307
 308 1;