src/core.pl

   1 #
   2 #   core.pl: Important functions stuff...
   3 #    Author: xk <xk@leguin.openprojects.net>
   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 $loggingstatus $talkchannel
  14         $statcount $memusage $user $memusageOld $infobot_version $dbh
  15         $shm $host $msg $infobot_misc_dir $infobot_pid $infobot_base_dir
  16         $infobot_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 $last{buflen}   = 0;
  39 $last{say}      = "";
  40 $last{msg}      = "";
  41 $userHandle     = "default";
  42 $msgtime        = time();
  43 $wingaterun     = time();
  44 $firsttime      = 1;
  45 $infobot_version = "blootbot 1.0.0 (20000725) -- $^O";
  46
  47 ##########
  48 ### misc commands.
  49 ###
  50
  51 sub doExit {
  52     my ($sig) = @_;
  53
  54     if (!defined $infobot_pid) {        # independent.
  55         exit 0;
  56     } elsif ($infobot_pid == $$) {      # parent.
  57         &status("parent caught SIG$sig (pid $$).") if (defined $sig);
  58
  59         my $type;
  60         &closeDCC();
  61         &closePID();
  62         &seenFlush();
  63         &quit($param{'quitMsg'}) if (&whatInterface() =~ /IRC/);
  64         &uptimeWriteFile();
  65         &closeDB();
  66         &closeSHM($shm);
  67         &dumpallvars()  if (&IsParam("dumpvarsAtExit"));
  68         &closeLog();
  69     } else {                                    # child.
  70         &status("child caught SIG$sig (pid $$).");
  71     }
  72
  73     exit 0;
  74 }
  75
  76 sub doWarn {
  77     $SIG{__WARN__} = sub { warn $_[0]; };
  78
  79     foreach (@_) {
  80         &WARN("PERL: $_");
  81     }
  82
  83     $SIG{__WARN__} = 'doWarn';
  84 }
  85
  86 # Usage: &IsParam($param);
  87 sub IsParam {
  88     my $param = $_[0];
  89
  90     return 0 unless (defined $param);
  91     return 0 unless (exists $param{$param});
  92     return 0 unless ($param{$param});
  93     return 0 if $param{$param} =~ /^false$/i;
  94     return 1;
  95 }
  96
  97 sub showProc {
  98     my ($prefix) = $_[0] || "";
  99
 100     if (!open(IN, "/proc/$$/status")) {
 101         &ERROR("cannot open '/proc/$$/status'.");
 102         return;
 103     }
 104
 105     if ($^O eq "linux") {
 106         while (<IN>) {
 107             $memusage = $1 if (/^VmSize:\s+(\d+) kB/);
 108         }
 109         close IN;
 110
 111         if (defined $memusageOld and &IsParam("DEBUG")) {
 112             # it's always going to be increase.
 113             my $delta = $memusage - $memusageOld;
 114             if ($delta > 500) {
 115                 &status("MEM:$prefix increased by $delta kB. (total: $memusage kB)");
 116             } elsif ($delta > 0) {
 117                 &status("MEM:$prefix increased by $delta kB.");
 118             } elsif ($delta < 0) {
 119                 $delta = -$delta;
 120                 # never knew RSS could decrease, probably Size can't?
 121                 &status("MEM:$prefix decreased by $delta kB. YES YES YES");
 122             }
 123         }
 124         $memusageOld = $memusage;
 125     } else {
 126         $memusage = "UNKNOWN";
 127     }
 128     ### TODO: FreeBSD/*BSD support.
 129 }
 130
 131 ######
 132 ###### SETUP
 133 ######
 134
 135 sub setup {
 136     &showProc(" (\&openLog before)");
 137     &openLog();         # write, append.
 138
 139     # read.
 140     &loadIgnore($infobot_misc_dir."/infobot.ignore");
 141     &loadLang($infobot_misc_dir."/infobot.lang");
 142     &loadIRCServers($infobot_misc_dir."/ircII.servers");
 143     &loadUsers($infobot_misc_dir."/infobot.users");
 144
 145     $shm = &openSHM();
 146     &openDB();
 147
 148     &status("Setup: ". &countKeys("factoids") ." factoids.");
 149
 150     &status("Initial memory usage: $memusage kB");
 151 }
 152
 153 sub setupConfig {
 154     &loadConfig($infobot_misc_dir."/infobot.config");
 155
 156     foreach ("ircNick", "ircUser", "ircName", "DBType") {
 157         next if &IsParam($_);
 158         &ERROR("Parameter $_ has not been defined.");
 159         exit 1;
 160     }
 161
 162     # static scalar variables.
 163     $file{utm}  = "$infobot_base_dir/$param{'ircUser'}.uptime";
 164     $file{PID}  = "$infobot_base_dir/$param{'ircUser'}.pid";
 165 }
 166
 167 sub startup {
 168     if (&IsParam("DEBUG")) {
 169         &status("enabling debug diagnostics.");
 170         ### I thought disabling this reduced memory usage by 1000 kB.
 171         use diagnostics;
 172     }
 173
 174     $count{'Question'}  = 0;
 175     $count{'Update'}    = 0;
 176     $count{'Dunno'}     = 0;
 177
 178     &loadMyModulesNow();
 179 }
 180
 181 sub shutdown {
 182     # reverse order of &setup().
 183     &closeDB();
 184     &closeSHM($shm);    # aswell. TODO: use this in &doExit?
 185     &closeLog();
 186 }
 187
 188 sub restart {
 189     my ($sig) = @_;
 190
 191     if ($$ == $infobot_pid) {
 192         &status("$sig called.");
 193
 194         ### crappy bug in Net::IRC?
 195         if (!$conn->connected and time - $msgtime > 900) {
 196             &status("reconnecting because of uncaught disconnect.");
 197 ##          $irc->start;
 198             $conn->connect();
 199             return;
 200         }
 201
 202         &shutdown();
 203         &loadConfig($infobot_misc_dir."/infobot.config");
 204         &reloadModules() if (&IsParam("DEBUG"));
 205         &setup();
 206
 207         &status("End of $sig.");
 208     } else {
 209         &status("$sig called; ignoring restart.");
 210     }
 211 }
 212
 213 # File: Configuration.
 214 sub loadConfig {
 215     my ($file) = @_;
 216
 217     if (!open(FILE, $file)) {
 218         &ERROR("FAILED loadConfig ($file): $!");
 219         &status("Please make sure the configuration file exists.");
 220         exit 1;
 221     }
 222
 223     my $count = 0;
 224     while (<FILE>) {
 225         chomp;
 226         next if /^\s*\#/;
 227         next unless /\S/;
 228         my ($set,$key,$val) = split(/\s+/, $_, 3);
 229
 230         if ($set ne "set") {
 231             &status("loadConfig: invalid line '$_'.");
 232             next;
 233         }
 234
 235         # perform variable interpolation
 236         $val =~ s/(\$(\w+))/$param{$2}/g;
 237
 238         $param{$key} = $val;
 239
 240         ++$count;
 241     }
 242     close FILE;
 243
 244     $file =~ s/^.*\///;
 245     &status("Loaded config $file ($count items)");
 246 }
 247
 248 1;