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