src/IRC/Schedulers.pl

   1 #
   2 # ProcessExtra.pl: Extensions to Process.pl
   3 #          Author: xk <xk@leguin.openprojects.net>
   4 #         Version: v0.3 (20000707)
   5 #         Created: 20000117
   6 #
   7
   8 if (&IsParam("useStrict")) { use strict; }
   9
  10 sub setupSchedulers {
  11     &VERB("Starting schedulers...",2);
  12
  13     # ONCE OFF.
  14
  15     # REPETITIVE.
  16     &uptimeCycle(1)     if (&IsParam("uptime"));
  17     &randomQuote(1)     if (&IsParam("randomQuote"));
  18     &randomFactoid(1)   if (&IsParam("randomFactoid"));
  19     &logCycle(1)        if ($loggingstatus and &IsParam("logFile") and &IsParam("maxLogSize"));
  20     &limitCheck(1)      if (&IsParam("limitcheck"));
  21     &netsplitCheck(1);  # mandatory
  22     &floodCycle(1);     # mandatory
  23     &seenFlush(1)       if (&IsParam("seen") and &IsParam("seenFlushInterval"));
  24     &leakCheck(1);      # mandatory
  25     &ignoreListCheck(1);# mandatory
  26     &seenFlushOld(1)    if (&IsParam("seen"));
  27     &ircCheck(1);       # mandatory
  28     &shmFlush(1);       # mandatory
  29     &slashdotCycle(1)   if (&IsParam("slashdot") and &IsParam("slashdotAnnounce"));
  30     &freshmeatCycle(1)  if (&IsParam("freshmeat") and &IsParam("freshmeatAnnounce"));
  31     &kernelCycle(1)     if (&IsParam("kernel") and &IsParam("kernelAnnounce"));
  32     &wingateWriteFile(1) if (&IsParam("wingate"));
  33 }
  34
  35 sub ScheduleThis {
  36     my ($interval, $codename, @args) = @_;
  37     my $waittime = &getRandomInt($interval);
  38
  39     &VERB("Scheduling \&$codename() for ".&Time2String($waittime),3);
  40     $conn->schedule($waittime, \&$codename, @args);
  41 }
  42
  43 sub randomQuote {
  44     my $line = &getRandomLineFromFile($infobot_misc_dir. "/infobot.randtext");
  45     if (!defined $line) {
  46         &ERROR("random Quote: weird error?");
  47         return;
  48     }
  49
  50     my @channels = split(/[\s\t]+/, lc $param{'randomQuoteChannels'});
  51     @channels    = keys(%channels) unless (scalar @channels);
  52
  53     my $good = 0;
  54     foreach (@channels) {
  55         next unless (&validChan($_));
  56
  57         &status("sending random Quote to $_.");
  58         &action($_, "Ponders: ".$line);
  59         $good++;
  60     }
  61
  62     if (!$good) {
  63         &WARN("randomQuote: no valid channels?");
  64         return;
  65     }
  66
  67     my $interval = $param{'randomQuoteInterval'} || 60;
  68     &ScheduleThis($interval, "randomQuote") if (@_);
  69 }
  70
  71 sub randomFactoid {
  72     my ($key,$val);
  73     my $error = 0;
  74     while (1) {
  75         ($key,$val) = &randKey("factoids","factoid_key,factoid_value");
  76 ###     $val =~ tr/^[A-Z]/[a-z]/;       # blah is Good => blah is good.
  77         last if ($val !~ /^</);
  78         $error++;
  79         if ($error == 5) {
  80             &ERROR("rF: tried 5 times but failed.");
  81             return;
  82         }
  83     }
  84
  85     my @channels = split(/[\s\t]+/, lc $param{'randomFactoidChannels'});
  86     @channels    = keys(%channels) unless (scalar @channels);
  87
  88     my $good = 0;
  89     foreach (@channels) {
  90         next unless (&validChan($_));
  91
  92         &status("sending random Factoid to $_.");
  93 ###     &msg($_, "$key is $val");
  94         &action($_, "Thinks: \037$key\037 is $val");
  95         ### FIXME: Use &getReply() on above to format factoid properly?
  96         $good++;
  97     }
  98
  99     if (!$good) {
 100         &WARN("randomFactoid: no valid channels?");
 101         return;
 102     }
 103
 104     my $interval = $param{'randomFactoidInterval'} || 60;
 105     &ScheduleThis($interval, "randomFactoid") if (@_);
 106 }
 107
 108 sub logCycle {
 109     if ( -s $file{log} > $param{'maxLogSize'}) {
 110         my $date = sprintf("%04d%02d%02d", (localtime)[5,4,3]);
 111         $file{log} = $param{'logfile'} ."-". $date;
 112         &status("cycling log file.");
 113
 114         if ( -e $file{log}) {
 115             my $i = 1;
 116             my $newlog;
 117             while () {
 118                 $newlog = $file{log}."-".$i;
 119                 last if (! -e $newlog);
 120                 $i++;
 121             }
 122             $file{log} = $newlog;
 123         }
 124
 125         &closeLog();
 126         system("/bin/mv '$param{'logfile'}' '$file{log}'");
 127         &compress($file{log});
 128         &openLog();
 129         &status("cycling log file.");
 130     }
 131
 132     &ScheduleThis(60, "logCycle") if (@_);
 133 }
 134
 135 sub seenFlushOld {
 136     my $max_time = $param{'seenMaxDays'}*60*60*24;
 137     my $delete   = 0;
 138
 139     if ($param{'DBType'} =~ /^pg|postgres|mysql/i) {
 140         my $query = "SELECT nick,time FROM seen GROUP BY nick HAVING UNIX_TIMESTAMP() - time > $max_time";
 141         my $sth = $dbh->prepare($query);
 142         $sth->execute;
 143
 144         while (my @row = $sth->fetchrow_array) {
 145             my ($nick,$time) = @row;
 146
 147             &dbDel("seen","nick",$nick);
 148             $delete++;
 149         }
 150         $sth->finish;
 151     } elsif ($param{'DBType'} =~ /^dbm/i) {
 152         my $time = time();
 153
 154         foreach (keys %seen) {
 155             my $delta_time = $time - &dbGet("seen", "NULL", $_, "time");
 156             next unless ($delta_time > $max_time);
 157
 158             &DEBUG("seenFlushOld: ".&Time2String($delta_time) );
 159             delete $seen{$_};
 160             $delete++;
 161         }
 162     } else {
 163         &FIXME("seenFlushOld: for PG/NO-DB.");
 164     }
 165     &VERB("SEEN deleted $delete seen entries.",2);
 166
 167     &ScheduleThis(1440, "seenFlushOld") if (@_);
 168 }
 169
 170 sub limitCheck {
 171     my $limitplus = $param{'limitcheckPlus'} || 5;
 172
 173     if (scalar keys %netsplit) {
 174         &status("limitcheck: netsplit active.");
 175         return;
 176     }
 177
 178     my @channels = split(/[\s\t]+/, lc $param{'limitcheck'});
 179
 180     foreach (@channels) {
 181         next unless (&validChan($_));
 182
 183         if (!exists $channels{$_}{'o'}{$ident}) {
 184             &ERROR("limitcheck: dont have ops on $_.");
 185             next;
 186         }
 187
 188         my $newlimit = scalar(keys %{$channels{$_}{''}}) + $limitplus;
 189         my $limit = $channels{$_}{'l'};
 190
 191         next unless (!defined $limit or $limit != $newlimit);
 192
 193         &rawout("MODE $_ +l $newlimit");
 194     }
 195
 196     my $interval = $param{'limitcheckInterval'} || 10;
 197     &ScheduleThis($interval, "limitCheck") if (@_);
 198 }
 199
 200 sub netsplitCheck {
 201     my ($s1,$s2);
 202
 203     foreach $s1 (keys %netsplitservers) {
 204         foreach $s2 (keys %{$netsplitservers{$s1}}) {
 205             if (time() - $netsplitservers{$s1}{$s2} > 3600) {
 206                 &status("netsplit between $s1 and $s2 appears to be stale.");
 207                 delete $netsplitservers{$s1}{$s2};
 208             }
 209         }
 210     }
 211
 212     &ScheduleThis(30, "netsplitCheck") if (@_);
 213 }
 214
 215 sub floodCycle {
 216     my $interval = $param{'floodInterval'} || 60;       # seconds.
 217     my $delete = 0;
 218
 219     my $who;
 220     foreach $who (keys %flood) {
 221         foreach (keys %{$flood{$who}}) {
 222             if (time() - $flood{$who}{$_} > $interval) {
 223                 delete $flood{$who}{$_};
 224                 $delete++;
 225             }
 226         }
 227     }
 228     &VERB("floodCycle: deleted $delete items.",2);
 229
 230     &ScheduleThis($interval, "floodCycle") if (@_);     # minutes.
 231 }
 232
 233 sub seenFlush {
 234     my $nick;
 235     my $flushed = 0;
 236
 237     if ($param{'DBType'} =~ /^mysql|pg|postgres/i) {
 238         foreach $nick (keys %seencache) {
 239             my $exists = &dbGet("seen","nick", $nick, "nick");
 240
 241             if (defined $exists and $exists) {
 242                 &dbUpdate("seen", "nick", $nick, (
 243                         "time" => $seencache{$nick}{'time'},
 244                         "host" => $seencache{$nick}{'host'},
 245                         "channel" => $seencache{$nick}{'chan'},
 246                         "message" => $seencache{$nick}{'msg'},
 247                 ) );
 248             } else {
 249                 my $retval = &dbInsert("seen", $nick, (
 250                         "nick" => $seencache{$nick}{'nick'},
 251                         "time" => $seencache{$nick}{'time'},
 252                         "host" => $seencache{$nick}{'host'},
 253                         "channel" => $seencache{$nick}{'chan'},
 254                         "message" => $seencache{$nick}{'msg'},
 255                 ) );
 256
 257                 ### TODO: put bad nick into a list and don't do it again!
 258                 if ($retval == 0) {
 259                     &ERROR("Should never happen! (nick => $nick) FIXME");
 260                 }
 261             }
 262
 263             delete $seencache{$nick};
 264             $flushed++;
 265         }
 266
 267     } elsif ($param{'DBType'} =~ /^dbm/i) {
 268
 269         foreach $nick (keys %seencache) {
 270             my $retval = &dbInsert("seen", $nick, (
 271                 "nick" => $seencache{$nick}{'nick'},
 272                 "time" => $seencache{$nick}{'time'},
 273                 "host" => $seencache{$nick}{'host'},
 274                 "channel" => $seencache{$nick}{'chan'},
 275                 "message" => $seencache{$nick}{'msg'},
 276             ) );
 277
 278             ### TODO: put bad nick into a list and don't do it again!
 279             if ($retval == 0) {
 280                 &ERROR("Should never happen! (nick => $nick) FIXME");
 281             }
 282
 283             delete $seencache{$nick};
 284             $flushed++;
 285         }
 286     } else {
 287         &DEBUG("seenFlush: NO VALID FACTOID SUPPORT?");
 288     }
 289
 290     &VERB("Flushed $flushed seen entries.",2);
 291
 292     my $interval = $param{'seenFlushInterval'} || 60;
 293     &ScheduleThis($interval, "seenFlush") if (@_);
 294 }
 295
 296 sub leakCheck {
 297     my ($blah1,$blah2);
 298     my $count = 0;
 299
 300     # flood.
 301     foreach $blah1 (keys %flood) {
 302         foreach $blah2 (keys %{$flood{$blah1}}) {
 303             $count += scalar(keys %{$flood{$blah1}{$blah2}});
 304         }
 305     }
 306     &VERB("\%flood has $count total keys.",2);
 307
 308     my $chan;
 309     foreach $chan (grep /[A-Z]/, keys %channels) {
 310         &DEBUG("leak: chan => '$chan'.");
 311         my ($i,$j);
 312         foreach $i (keys %{$channels{$chan}}) {
 313             foreach (keys %{$channels{$chan}{$i}}) {
 314                 &DEBUG("leak:   \$channels{$chan}{$i}{$_} ...");
 315             }
 316         }
 317     }
 318
 319     &ScheduleThis(60, "leakCheck") if (@_);
 320 }
 321
 322 sub ignoreListCheck {
 323     my $time = time();
 324     my $count = 0;
 325
 326     foreach (keys %ignoreList) {
 327         next if ($ignoreList{$_} == 1);
 328         next unless ($time > $ignoreList{$_});
 329
 330         delete $ignoreList{$_};
 331         &status("ignore: $_ has expired.");
 332         $count++;
 333     }
 334     &VERB("ignore: $count items deleted.",2);
 335
 336     &ScheduleThis(30, "ignoreListCheck") if (@_);
 337 }
 338
 339 sub ircCheck {
 340     my @array = split /[\t\s]+/, $param{'join_channels'};
 341     my $iconf = scalar(@array);
 342     my $inow  = scalar(keys %channels);
 343     if ($iconf > 2 and $inow * 2 <= $iconf) {
 344         &FIXME("ircCheck: current channels * 2 <= config channels. FIXME.");
 345     }
 346
 347     # shmid stale remove.
 348     foreach (`ipcs`) {
 349         chop;
 350
 351         # key, shmid, owner, perms, bytes, nattch
 352         next unless (/^(0x\d+) (\d+)\s+(\S+)\s+(\d+)\s+(\d+)\s+/);
 353
 354         my ($shmid, $size) = ($2,$5);
 355         next unless ($shmid != $shm and $size == 2000);
 356
 357         &status("SHM: nuking shmid $shmid");
 358         system("ipcrm shm $shmid >/dev/null");
 359     }
 360
 361     if (!$conn->connected and time - $msgtime > 3600) {
 362         &WARN("ircCheck: no msg for 3600 and disco'd! reconnecting!");
 363         $msgtime = time();      # just in case.
 364         &ircloop();
 365     }
 366
 367     if ($ident !~ /^\Q$param{ircNick}\E$/) {
 368         &WARN("ircCheck: ident($ident) != param{ircNick}($param{IrcNick}).");
 369     }
 370
 371     &ScheduleThis(240, "ircCheck") if (@_);
 372 }
 373
 374 sub shmFlush {
 375     my $shmmsg = &shmRead($shm);
 376     $shmmsg =~ s/\0//g;         # remove padded \0's.
 377
 378     foreach (split '\|\|', $shmmsg) {
 379         &status("shm: Processing '$_'.");
 380
 381         if (/^DCC SEND (\S+) (\S+)$/) {
 382             my ($nick,$file) = ($1,$2);
 383             if (exists $dcc{'SEND'}{$who}) {
 384                 &msg($nick,"DCC already active.");
 385             } else {
 386                 &DEBUG("shm: dcc sending $2 to $1.");
 387                 $conn->new_send($1,$2);
 388                 $dcc{'SEND'}{$who} = time();
 389             }
 390         } elsif (/^DELETE FORK (\S+)$/) {
 391             delete $forked{$1};
 392         } elsif (/^EVAL (.*)$/) {
 393             &DEBUG("evaling '$1'.");
 394             eval $1;
 395         } else {
 396             &DEBUG("shm: unknown msg. ($_)");
 397         }
 398     }
 399
 400     &shmWrite($shm,"") if ($shmmsg ne "");
 401
 402     &ScheduleThis(5, "shmFlush") if (@_);
 403 }
 404
 405 sub uptimeCycle {
 406     &uptimeWriteFile();
 407
 408     &ScheduleThis(60, "uptimeCycle") if (@_);
 409 }
 410
 411 sub slashdotCycle {
 412     &Forker("slashdot", sub { &Slashdot::slashdotAnnounce(); } );
 413
 414     &ScheduleThis(60, "slashdotCycle") if (@_);
 415 }
 416
 417 sub freshmeatCycle {
 418     &Forker("freshmeat", sub { &Freshmeat::freshmeatAnnounce(); } );
 419
 420     &ScheduleThis(60, "freshmeatCycle") if (@_);
 421 }
 422
 423 sub kernelCycle {
 424     &Forker("kernel", sub { &Kernel::kernelAnnounce(); } );
 425
 426     &ScheduleThis(240, "kernelCycle") if (@_);
 427 }
 428
 429 sub wingateCheck {
 430     return unless &IsParam("wingate");
 431     return unless ($param{'wingate'} =~ /^(.*\s+)?$chan(\s+.*)?$/i);
 432
 433     ### FILE CACHE OF OFFENDING WINGATES.
 434     foreach (grep /^$host$/, @wingateBad) {
 435         &status("Wingate: RUNNING ON $host BY $who");
 436         &ban("*!*\@$host", "") if &IsParam("wingateBan");
 437
 438         next unless (&IsParam("wingateKick"));
 439         &kick($who, "", $param{'wingateKick'})
 440     }
 441
 442     ### RUN CACHE OF TRIED WINGATES.
 443     if (grep /^$host$/, @wingateCache) {
 444         push(@wingateNow, $host);       # per run.
 445         push(@wingateCache, $host);     # cache per run.
 446     } else {
 447         &DEBUG("Already scanned $host. good.");
 448     }
 449
 450     my $interval = $param{'wingateInterval'} || 60;     # seconds.
 451     return if (defined $forked{'wingate'});
 452     return if (time() - $wingaterun <= $interval);
 453     return unless (scalar(keys %wingateToDo));
 454
 455     $wingaterun = time();
 456
 457     &Forker("wingate", sub { &Wingate::Wingates(keys %wingateToDo); } );
 458     undef @wingateNow;
 459 }
 460
 461 ### TODO.
 462 sub wingateWriteFile {
 463     return unless (scalar @wingateCache);
 464
 465     my $file = "$infobot_base_dir/$param{'ircUser'}.wingate";
 466     if ($infobot_pid != $$) {
 467         &DEBUG("wingateWriteFile: Reorganising!");
 468
 469         open(IN, $file);
 470         while (<IN>) {
 471             chop;
 472             push(@wingateNow, $_);
 473         }
 474         close IN;
 475
 476         # very lame hack.
 477         my %hash = map { $_ => 1 } @wingateNow;
 478         @wingateNow = sort keys %hash;
 479     }
 480
 481     &DEBUG("wingateWF: writing...");
 482     open(OUT, ">$file");
 483     foreach (@wingateNow) {
 484         print OUT "$_\n";
 485     }
 486     close OUT;
 487
 488     &ScheduleThis(60, "wingateWriteFile") if (@_);
 489 }
 490
 491 1;