src/IRC/Schedulers.pl

   1 #
   2 # ProcessExtra.pl: Extensions to Process.pl
   3 #          Author: dms
   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     &miscCheck(1);      # mandatory
  29     &shmFlush(1);       # mandatory
  30     &slashdotCycle(1)   if (&IsParam("slashdot") and &IsParam("slashdotAnnounce"));
  31     &freshmeatCycle(1)  if (&IsParam("freshmeat") and &IsParam("freshmeatAnnounce"));
  32     &kernelCycle(1)     if (&IsParam("kernel") and &IsParam("kernelAnnounce"));
  33     &wingateWriteFile(1) if (&IsParam("wingate"));
  34 }
  35
  36 sub ScheduleThis {
  37     my ($interval, $codename, @args) = @_;
  38     my $waittime = &getRandomInt($interval);
  39
  40     &VERB("Scheduling \&$codename() for ".&Time2String($waittime),3);
  41     $conn->schedule($waittime, \&$codename, @args);
  42 }
  43
  44 sub randomQuote {
  45     my $line = &getRandomLineFromFile($bot_misc_dir. "/blootbot.randtext");
  46     if (!defined $line) {
  47         &ERROR("random Quote: weird error?");
  48         return;
  49     }
  50
  51     my @channels = split(/[\s\t]+/, lc $param{'randomQuoteChannels'});
  52     @channels    = keys(%channels) unless (scalar @channels);
  53
  54     my $good = 0;
  55     foreach (@channels) {
  56         next unless (&validChan($_));
  57
  58         &status("sending random Quote to $_.");
  59         &action($_, "Ponders: ".$line);
  60         $good++;
  61     }
  62
  63     if (!$good) {
  64         &WARN("randomQuote: no valid channels?");
  65         return;
  66     }
  67
  68     my $interval = $param{'randomQuoteInterval'} || 60;
  69     &ScheduleThis($interval, "randomQuote") if (@_);
  70 }
  71
  72 sub randomFactoid {
  73     my ($key,$val);
  74     my $error = 0;
  75     while (1) {
  76         ($key,$val) = &randKey("factoids","factoid_key,factoid_value");
  77 ###     $val =~ tr/^[A-Z]/[a-z]/;       # blah is Good => blah is good.
  78         last if ($val !~ /^</);
  79         $error++;
  80         if ($error == 5) {
  81             &ERROR("rF: tried 5 times but failed.");
  82             return;
  83         }
  84     }
  85
  86     my @channels = split(/[\s\t]+/, lc $param{'randomFactoidChannels'});
  87     @channels    = keys(%channels) unless (scalar @channels);
  88
  89     my $good = 0;
  90     foreach (@channels) {
  91         next unless (&validChan($_));
  92
  93         &status("sending random Factoid to $_.");
  94 ###     &msg($_, "$key is $val");
  95         &action($_, "Thinks: \037$key\037 is $val");
  96         ### FIXME: Use &getReply() on above to format factoid properly?
  97         $good++;
  98     }
  99
 100     if (!$good) {
 101         &WARN("randomFactoid: no valid channels?");
 102         return;
 103     }
 104
 105     my $interval = $param{'randomFactoidInterval'} || 60;
 106     &ScheduleThis($interval, "randomFactoid") if (@_);
 107 }
 108
 109 sub logCycle {
 110     # check if current size is too large.
 111     if ( -s $file{log} > $param{'maxLogSize'}) {
 112         my $date = sprintf("%04d%02d%02d", (localtime)[5,4,3]);
 113         $file{log} = $param{'logfile'} ."-". $date;
 114         &status("cycling log file.");
 115
 116         if ( -e $file{log}) {
 117             my $i = 1;
 118             my $newlog;
 119             while () {
 120                 $newlog = $file{log}."-".$i;
 121                 last if (! -e $newlog);
 122                 $i++;
 123             }
 124             $file{log} = $newlog;
 125         }
 126
 127         &closeLog();
 128         system("/bin/mv '$param{'logfile'}' '$file{log}'");
 129         &compress($file{log});
 130         &openLog();
 131         &status("cycling log file.");
 132     }
 133
 134     # check if all the logs exceed size.
 135     my $logdir = "$bot_base_dir/log/";
 136     if (opendir(LOGS, $logdir)) {
 137         my $tsize = 0;
 138         my (%age, %size);
 139
 140         while (defined($_ = readdir LOGS)) {
 141             my $logfile = "$logdir/$_";
 142
 143             next unless ( -f $logfile);
 144             my $size = -s $logfile;
 145             my $age = (stat $logfile)[9]; ### or 8 ?
 146
 147             $age{$age}          = $logfile;
 148             $size{$logfile}     = $size;
 149
 150             $tsize              += $size;
 151         }
 152         closedir LOGS;
 153
 154         my $delete = 0;
 155         while ($tsize > $param{'maxLogSize'}) {
 156             &status("LOG: current size > max ($tsize > $param{'maxLogSize'})");
 157             my $oldest = (sort {$a <=> $b} keys %age)[0];
 158             &status("LOG: unlinking $age{$oldest}.");
 159             ### NOT YET.
 160             # unlink $age{$oldest};
 161             $tsize -= $oldest;
 162             $delete++;
 163         }
 164
 165         ### TODO: add how many b,kb,mb removed?
 166         if ($delete) {
 167             &status("LOG: removed $delete logs.");
 168         }
 169     } else {
 170         &WARN("could not open dir $logdir");
 171     }
 172
 173     &ScheduleThis(60, "logCycle") if (@_);
 174 }
 175
 176 sub seenFlushOld {
 177     my $max_time = $param{'seenMaxDays'}*60*60*24;
 178     my $delete   = 0;
 179
 180     if ($param{'DBType'} =~ /^pg|postgres|mysql/i) {
 181         my $query = "SELECT nick,time FROM seen GROUP BY nick HAVING UNIX_TIMESTAMP() - time > $max_time";
 182         my $sth = $dbh->prepare($query);
 183         $sth->execute;
 184
 185         while (my @row = $sth->fetchrow_array) {
 186             my ($nick,$time) = @row;
 187
 188             &dbDel("seen","nick",$nick);
 189             $delete++;
 190         }
 191         $sth->finish;
 192     } elsif ($param{'DBType'} =~ /^dbm/i) {
 193         my $time = time();
 194
 195         foreach (keys %seen) {
 196             my $delta_time = $time - &dbGet("seen", "NULL", $_, "time");
 197             next unless ($delta_time > $max_time);
 198
 199             &DEBUG("seenFlushOld: ".&Time2String($delta_time) );
 200             delete $seen{$_};
 201             $delete++;
 202         }
 203     } else {
 204         &FIXME("seenFlushOld: for PG/NO-DB.");
 205     }
 206     &VERB("SEEN deleted $delete seen entries.",2);
 207
 208     &ScheduleThis(1440, "seenFlushOld") if (@_);
 209 }
 210
 211 sub limitCheck {
 212     my $limitplus = $param{'limitcheckPlus'} || 5;
 213
 214     if (scalar keys %netsplit) {
 215         &status("limitcheck: netsplit active.");
 216         return;
 217     }
 218
 219     my @channels = split(/[\s\t]+/, lc $param{'limitcheck'});
 220
 221     foreach (@channels) {
 222         next unless (&validChan($_));
 223
 224         if (!exists $channels{$_}{'o'}{$ident}) {
 225             &ERROR("limitcheck: dont have ops on $_.");
 226             next;
 227         }
 228
 229         my $newlimit = scalar(keys %{$channels{$_}{''}}) + $limitplus;
 230         my $limit = $channels{$_}{'l'};
 231
 232         next unless (!defined $limit or $limit != $newlimit);
 233
 234         &rawout("MODE $_ +l $newlimit");
 235     }
 236
 237     my $interval = $param{'limitcheckInterval'} || 10;
 238     &ScheduleThis($interval, "limitCheck") if (@_);
 239 }
 240
 241 sub netsplitCheck {
 242     my ($s1,$s2);
 243
 244     foreach $s1 (keys %netsplitservers) {
 245         foreach $s2 (keys %{$netsplitservers{$s1}}) {
 246             if (time() - $netsplitservers{$s1}{$s2} > 3600) {
 247                 &status("netsplit between $s1 and $s2 appears to be stale.");
 248                 delete $netsplitservers{$s1}{$s2};
 249             }
 250         }
 251     }
 252
 253     # %netsplit hash checker.
 254     foreach (keys %netsplit) {
 255         if (&IsNickInAnyChan($_)) {
 256             &DEBUG("netsplitC: $_ is in some chan; removing from netsplit list.");
 257             delete $netsplit{$_};
 258         }
 259         next unless (time() - $netsplit{$_} > 60*60*2); # 2 hours.
 260
 261         if (!&IsNickInAnyChan($_)) {
 262             &DEBUG("netsplitC: $_ didn't come back from netsplit in 2 hours; removing from netsplit list.");
 263             delete $netsplit{$_};
 264         }
 265     }
 266
 267     &ScheduleThis(30, "netsplitCheck") if (@_);
 268 }
 269
 270 sub floodCycle {
 271     my $interval = $param{'floodInterval'} || 60;       # seconds.
 272     my $delete = 0;
 273
 274     my $who;
 275     foreach $who (keys %flood) {
 276         foreach (keys %{$flood{$who}}) {
 277             if (time() - $flood{$who}{$_} > $interval) {
 278                 delete $flood{$who}{$_};
 279                 $delete++;
 280             }
 281         }
 282     }
 283     &VERB("floodCycle: deleted $delete items.",2);
 284
 285     &ScheduleThis($interval, "floodCycle") if (@_);     # minutes.
 286 }
 287
 288 sub seenFlush {
 289     my $nick;
 290     my $flushed = 0;
 291
 292     if ($param{'DBType'} =~ /^mysql|pg|postgres/i) {
 293         foreach $nick (keys %seencache) {
 294             my $exists = &dbGet("seen","nick", $nick, "nick");
 295
 296             if (defined $exists and $exists) {
 297                 &dbUpdate("seen", "nick", $nick, (
 298                         "time" => $seencache{$nick}{'time'},
 299                         "host" => $seencache{$nick}{'host'},
 300                         "channel" => $seencache{$nick}{'chan'},
 301                         "message" => $seencache{$nick}{'msg'},
 302                 ) );
 303             } else {
 304                 my $retval = &dbInsert("seen", $nick, (
 305                         "nick" => $seencache{$nick}{'nick'},
 306                         "time" => $seencache{$nick}{'time'},
 307                         "host" => $seencache{$nick}{'host'},
 308                         "channel" => $seencache{$nick}{'chan'},
 309                         "message" => $seencache{$nick}{'msg'},
 310                 ) );
 311
 312                 ### TODO: put bad nick into a list and don't do it again!
 313                 if ($retval == 0) {
 314                     &ERROR("Should never happen! (nick => $nick) FIXME");
 315                 }
 316             }
 317
 318             delete $seencache{$nick};
 319             $flushed++;
 320         }
 321
 322     } elsif ($param{'DBType'} =~ /^dbm/i) {
 323
 324         foreach $nick (keys %seencache) {
 325             my $retval = &dbInsert("seen", $nick, (
 326                 "nick" => $seencache{$nick}{'nick'},
 327                 "time" => $seencache{$nick}{'time'},
 328                 "host" => $seencache{$nick}{'host'},
 329                 "channel" => $seencache{$nick}{'chan'},
 330                 "message" => $seencache{$nick}{'msg'},
 331             ) );
 332
 333             ### TODO: put bad nick into a list and don't do it again!
 334             if ($retval == 0) {
 335                 &ERROR("Should never happen! (nick => $nick) FIXME");
 336             }
 337
 338             delete $seencache{$nick};
 339             $flushed++;
 340         }
 341     } else {
 342         &DEBUG("seenFlush: NO VALID FACTOID SUPPORT?");
 343     }
 344
 345     &VERB("Flushed $flushed seen entries.",1); # was 2.
 346     &DEBUG("seen: ".scalar(keys %seenflush)." remaining.");
 347
 348     my $interval = $param{'seenFlushInterval'} || 60;
 349     &ScheduleThis($interval, "seenFlush") if (@_);
 350 }
 351
 352 sub leakCheck {
 353     my ($blah1,$blah2);
 354     my $count = 0;
 355
 356     # flood.
 357     foreach $blah1 (keys %flood) {
 358         foreach $blah2 (keys %{$flood{$blah1}}) {
 359             $count += scalar(keys %{$flood{$blah1}{$blah2}});
 360         }
 361     }
 362     &VERB("\%flood has $count total keys.",2);
 363
 364     my $chan;
 365     foreach $chan (grep /[A-Z]/, keys %channels) {
 366         &DEBUG("leak: chan => '$chan'.");
 367         my ($i,$j);
 368         foreach $i (keys %{$channels{$chan}}) {
 369             foreach (keys %{$channels{$chan}{$i}}) {
 370                 &DEBUG("leak:   \$channels{$chan}{$i}{$_} ...");
 371             }
 372         }
 373     }
 374
 375     &ScheduleThis(60, "leakCheck") if (@_);
 376 }
 377
 378 sub ignoreListCheck {
 379     my $time = time();
 380     my $count = 0;
 381
 382     foreach (keys %ignoreList) {
 383         next if ($ignoreList{$_} == 1);
 384         next unless ($time > $ignoreList{$_});
 385
 386         delete $ignoreList{$_};
 387         &status("ignore: $_ has expired.");
 388         $count++;
 389     }
 390     &VERB("ignore: $count items deleted.",2);
 391
 392     &ScheduleThis(30, "ignoreListCheck") if (@_);
 393 }
 394
 395 sub ircCheck {
 396     my @array = split /[\t\s]+/, $param{'join_channels'};
 397     my $iconf = scalar(@array);
 398     my $inow  = scalar(keys %channels);
 399     if ($iconf > 2 and $inow * 2 <= $iconf) {
 400         &FIXME("ircCheck: current channels * 2 <= config channels. FIXME.");
 401     }
 402
 403     if (!$conn->connected and time - $msgtime > 3600) {
 404         &WARN("ircCheck: no msg for 3600 and disco'd! reconnecting!");
 405         $msgtime = time();      # just in case.
 406         &ircloop();
 407     }
 408
 409     if ($ident !~ /^\Q$param{ircNick}\E$/) {
 410         &WARN("ircCheck: ident($ident) != param{ircNick}($param{IrcNick}).");
 411     }
 412
 413     if (scalar @joinchan) {
 414         &WARN("We have some channels to join, doing so.");
 415         &joinNextChan();
 416     }
 417
 418     if (grep /^\s*$/, keys %channels) {
 419         &WARN("we have a NULL chan in hash channels? removing!");
 420         delete $channels{''};
 421         &status("channels now:");
 422         foreach (keys %channels) {
 423             &status("  $_");
 424         }
 425     }
 426
 427
 428     &ScheduleThis(240, "ircCheck") if (@_);
 429 }
 430
 431 sub miscCheck {
 432     # SHM check.
 433     my @ipcs;
 434     if ( -x "/usr/bin/ipcs") {
 435         @ipcs = `/usr/bin/ipcs`;
 436     } else {
 437         &WARN("ircCheck: no 'ipcs' binary.");
 438     }
 439
 440     # shmid stale remove.
 441     foreach (@ipcs) {
 442         chop;
 443
 444         # key, shmid, owner, perms, bytes, nattch
 445         next unless (/^(0x\d+) (\d+)\s+(\S+)\s+(\d+)\s+(\d+)\s+/);
 446
 447         my ($shmid, $size) = ($2,$5);
 448         next unless ($shmid != $shm and $size == 2000);
 449
 450         &status("SHM: nuking shmid $shmid");
 451         system("/usr/bin/ipcrm shm $shmid >/dev/null");
 452     }
 453
 454     ### check modules if they've been modified. might be evil.
 455     &reloadAllModules();
 456
 457     &ScheduleThis(240, "miscCheck") if (@_);
 458 }
 459
 460 sub shmFlush {
 461     my $shmmsg = &shmRead($shm);
 462     $shmmsg =~ s/\0//g;         # remove padded \0's.
 463
 464     foreach (split '\|\|', $shmmsg) {
 465         &status("shm: Processing '$_'.");
 466
 467         if (/^DCC SEND (\S+) (\S+)$/) {
 468             my ($nick,$file) = ($1,$2);
 469             if (exists $dcc{'SEND'}{$who}) {
 470                 &msg($nick,"DCC already active.");
 471             } else {
 472                 &DEBUG("shm: dcc sending $2 to $1.");
 473                 $conn->new_send($1,$2);
 474                 $dcc{'SEND'}{$who} = time();
 475             }
 476         } elsif (/^DELETE FORK (\S+)$/) {
 477             delete $forked{$1};
 478         } elsif (/^EVAL (.*)$/) {
 479             &DEBUG("evaling '$1'.");
 480             eval $1;
 481         } else {
 482             &DEBUG("shm: unknown msg. ($_)");
 483         }
 484     }
 485
 486     &shmWrite($shm,"") if ($shmmsg ne "");
 487
 488     &ScheduleThis(5, "shmFlush") if (@_);
 489 }
 490
 491 sub getNickInUse {
 492     if ($ident eq $param{'ircNick'}) {
 493         &status("okay, got my nick back.");
 494         return;
 495     }
 496
 497     &status("Trying to get my nick back.");
 498     &nick($param{'ircNick'});
 499
 500     &ScheduleThis(5, "getNickInUse") if (@_);
 501 }
 502
 503 sub uptimeCycle {
 504     &uptimeWriteFile();
 505
 506     &ScheduleThis(60, "uptimeCycle") if (@_);
 507 }
 508
 509 sub slashdotCycle {
 510     &Forker("slashdot", sub { &Slashdot::slashdotAnnounce(); } );
 511
 512     &ScheduleThis(60, "slashdotCycle") if (@_);
 513 }
 514
 515 sub freshmeatCycle {
 516     &Forker("freshmeat", sub { &Freshmeat::freshmeatAnnounce(); } );
 517
 518     &ScheduleThis(60, "freshmeatCycle") if (@_);
 519 }
 520
 521 sub kernelCycle {
 522     &Forker("kernel", sub { &Kernel::kernelAnnounce(); } );
 523
 524     &ScheduleThis(240, "kernelCycle") if (@_);
 525 }
 526
 527 sub wingateCheck {
 528     return unless &IsParam("wingate");
 529     return unless ($param{'wingate'} =~ /^(.*\s+)?$chan(\s+.*)?$/i);
 530
 531     ### FILE CACHE OF OFFENDING WINGATES.
 532     foreach (grep /^$host$/, @wingateBad) {
 533         &status("Wingate: RUNNING ON $host BY $who");
 534         &ban("*!*\@$host", "") if &IsParam("wingateBan");
 535
 536         next unless (&IsParam("wingateKick"));
 537         &kick($who, "", $param{'wingateKick'})
 538     }
 539
 540     ### RUN CACHE OF TRIED WINGATES.
 541     if (grep /^$host$/, @wingateCache) {
 542         push(@wingateNow, $host);       # per run.
 543         push(@wingateCache, $host);     # cache per run.
 544     } else {
 545         &DEBUG("Already scanned $host. good.");
 546     }
 547
 548     my $interval = $param{'wingateInterval'} || 60;     # seconds.
 549     return if (defined $forked{'wingate'});
 550     return if (time() - $wingaterun <= $interval);
 551     return unless (scalar(keys %wingateToDo));
 552
 553     $wingaterun = time();
 554
 555     &Forker("wingate", sub { &Wingate::Wingates(keys %wingateToDo); } );
 556     undef @wingateNow;
 557 }
 558
 559 ### TODO.
 560 sub wingateWriteFile {
 561     return unless (scalar @wingateCache);
 562
 563     my $file = "$bot_base_dir/$param{'ircUser'}.wingate";
 564     if ($bot_pid != $$) {
 565         &DEBUG("wingateWriteFile: Reorganising!");
 566
 567         open(IN, $file);
 568         while (<IN>) {
 569             chop;
 570             push(@wingateNow, $_);
 571         }
 572         close IN;
 573
 574         # very lame hack.
 575         my %hash = map { $_ => 1 } @wingateNow;
 576         @wingateNow = sort keys %hash;
 577     }
 578
 579     &DEBUG("wingateWF: writing...");
 580     open(OUT, ">$file");
 581     foreach (@wingateNow) {
 582         print OUT "$_\n";
 583     }
 584     close OUT;
 585
 586     &ScheduleThis(60, "wingateWriteFile") if (@_);
 587 }
 588
 589 1;