src/IRC/Schedulers.pl

   1 #
   2 # ProcessExtra.pl: Extensions to Process.pl
   3 #          Author: dms
   4 #         Version: v0.4 (20000918)
   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     my %stats;
 292     $stats{'count_old'} = &countKeys("seen");
 293     $stats{'new'}       = 0;
 294     $stats{'old'}       = 0;
 295
 296     if ($param{'DBType'} =~ /^mysql|pg|postgres/i) {
 297         foreach $nick (keys %seencache) {
 298             my $exists = &dbGet("seen","nick", $nick, "nick");
 299
 300             if (defined $exists and $exists) {
 301                 &dbUpdate("seen", "nick", $nick, (
 302                         "time" => $seencache{$nick}{'time'},
 303                         "host" => $seencache{$nick}{'host'},
 304                         "channel" => $seencache{$nick}{'chan'},
 305                         "message" => $seencache{$nick}{'msg'},
 306                 ) );
 307                 $stats{'old'}++;
 308             } else {
 309                 my $retval = &dbInsert("seen", $nick, (
 310                         "nick" => $seencache{$nick}{'nick'},
 311                         "time" => $seencache{$nick}{'time'},
 312                         "host" => $seencache{$nick}{'host'},
 313                         "channel" => $seencache{$nick}{'chan'},
 314                         "message" => $seencache{$nick}{'msg'},
 315                 ) );
 316                 $stats{'new'}++;
 317
 318                 ### TODO: put bad nick into a list and don't do it again!
 319                 if ($retval == 0) {
 320                     &ERROR("Should never happen! (nick => $nick) FIXME");
 321                 }
 322             }
 323
 324             delete $seencache{$nick};
 325             $flushed++;
 326         }
 327
 328     } elsif ($param{'DBType'} =~ /^dbm/i) {
 329
 330         foreach $nick (keys %seencache) {
 331             my $retval = &dbInsert("seen", $nick, (
 332                 "nick" => $seencache{$nick}{'nick'},
 333                 "time" => $seencache{$nick}{'time'},
 334                 "host" => $seencache{$nick}{'host'},
 335                 "channel" => $seencache{$nick}{'chan'},
 336                 "message" => $seencache{$nick}{'msg'},
 337             ) );
 338
 339             ### TODO: put bad nick into a list and don't do it again!
 340             if ($retval == 0) {
 341                 &ERROR("Should never happen! (nick => $nick) FIXME");
 342             }
 343
 344             delete $seencache{$nick};
 345             $flushed++;
 346         }
 347     } else {
 348         &DEBUG("seenFlush: NO VALID FACTOID SUPPORT?");
 349     }
 350
 351     &DEBUG(sprintf("new seen: %03.01f%% (%d/%d)",
 352                         $stats{'new'}*100/$stats{'count_old'}),
 353                         $stats{'new'}, $stats{'count_old'} );
 354     &DEBUG(sprintf("now seen: %3.1f%% (%d/%d)",
 355                         $stats{'old'}*100/&countKeys("seen")),
 356                         $stats{'old'}, &countKeys("seen") );
 357
 358     &VERB("Flushed $flushed seen entries.",1); # was 2.
 359     &DEBUG("seen: ".scalar(keys %seenflush)." remaining.");
 360
 361     my $interval = $param{'seenFlushInterval'} || 60;
 362     &ScheduleThis($interval, "seenFlush") if (@_);
 363 }
 364
 365 sub leakCheck {
 366     my ($blah1,$blah2);
 367     my $count = 0;
 368
 369     # flood.
 370     foreach $blah1 (keys %flood) {
 371         foreach $blah2 (keys %{$flood{$blah1}}) {
 372             $count += scalar(keys %{$flood{$blah1}{$blah2}});
 373         }
 374     }
 375     &VERB("\%flood has $count total keys.",2);
 376
 377     my $chan;
 378     foreach $chan (grep /[A-Z]/, keys %channels) {
 379         &DEBUG("leak: chan => '$chan'.");
 380         my ($i,$j);
 381         foreach $i (keys %{$channels{$chan}}) {
 382             foreach (keys %{$channels{$chan}{$i}}) {
 383                 &DEBUG("leak:   \$channels{$chan}{$i}{$_} ...");
 384             }
 385         }
 386     }
 387
 388     &ScheduleThis(60, "leakCheck") if (@_);
 389 }
 390
 391 sub ignoreListCheck {
 392     my $time = time();
 393     my $count = 0;
 394
 395     foreach (keys %ignoreList) {
 396         next if ($ignoreList{$_} == 1);
 397         next unless ($time > $ignoreList{$_});
 398
 399         delete $ignoreList{$_};
 400         &status("ignore: $_ has expired.");
 401         $count++;
 402     }
 403     &VERB("ignore: $count items deleted.",2);
 404
 405     &ScheduleThis(30, "ignoreListCheck") if (@_);
 406 }
 407
 408 sub ircCheck {
 409     my @array = split /[\t\s]+/, $param{'join_channels'};
 410     my $iconf = scalar(@array);
 411     my $inow  = scalar(keys %channels);
 412     if ($iconf > 2 and $inow * 2 <= $iconf) {
 413         &FIXME("ircCheck: current channels * 2 <= config channels. FIXME.");
 414     }
 415
 416     if (!$conn->connected and time - $msgtime > 3600) {
 417         &WARN("ircCheck: no msg for 3600 and disco'd! reconnecting!");
 418         $msgtime = time();      # just in case.
 419         &ircloop();
 420     }
 421
 422     if ($ident !~ /^\Q$param{ircNick}\E$/) {
 423         &WARN("ircCheck: ident($ident) != param{ircNick}($param{IrcNick}).");
 424     }
 425
 426     &joinNextChan();
 427         # if scalar @joinnext => join more channels
 428         # else check for chanserv.
 429
 430     if (grep /^\s*$/, keys %channels) {
 431         &WARN("we have a NULL chan in hash channels? removing!");
 432         delete $channels{''};
 433         &status("channels now:");
 434         foreach (keys %channels) {
 435             &status("  $_");
 436         }
 437     }
 438
 439
 440     &ScheduleThis(240, "ircCheck") if (@_);
 441 }
 442
 443 sub miscCheck {
 444     # SHM check.
 445     my @ipcs;
 446     if ( -x "/usr/bin/ipcs") {
 447         @ipcs = `/usr/bin/ipcs`;
 448     } else {
 449         &WARN("ircCheck: no 'ipcs' binary.");
 450     }
 451
 452     # shmid stale remove.
 453     foreach (@ipcs) {
 454         chop;
 455
 456         # key, shmid, owner, perms, bytes, nattch
 457         next unless (/^(0x\d+) (\d+)\s+(\S+)\s+(\d+)\s+(\d+)\s+/);
 458
 459         my ($shmid, $size) = ($2,$5);
 460         next unless ($shmid != $shm and $size == 2000);
 461
 462         &status("SHM: nuking shmid $shmid");
 463         system("/usr/bin/ipcrm shm $shmid >/dev/null");
 464     }
 465
 466     ### check modules if they've been modified. might be evil.
 467     &reloadAllModules();
 468
 469     &ScheduleThis(240, "miscCheck") if (@_);
 470 }
 471
 472 sub shmFlush {
 473     my $shmmsg = &shmRead($shm);
 474     $shmmsg =~ s/\0//g;         # remove padded \0's.
 475
 476     foreach (split '\|\|', $shmmsg) {
 477         &status("shm: Processing '$_'.");
 478
 479         if (/^DCC SEND (\S+) (\S+)$/) {
 480             my ($nick,$file) = ($1,$2);
 481             if (exists $dcc{'SEND'}{$who}) {
 482                 &msg($nick,"DCC already active.");
 483             } else {
 484                 &DEBUG("shm: dcc sending $2 to $1.");
 485                 $conn->new_send($1,$2);
 486                 $dcc{'SEND'}{$who} = time();
 487             }
 488         } elsif (/^DELETE FORK (\S+)$/) {
 489             delete $forked{$1};
 490         } elsif (/^EVAL (.*)$/) {
 491             &DEBUG("evaling '$1'.");
 492             eval $1;
 493         } else {
 494             &DEBUG("shm: unknown msg. ($_)");
 495         }
 496     }
 497
 498     &shmWrite($shm,"") if ($shmmsg ne "");
 499
 500     &ScheduleThis(5, "shmFlush") if (@_);
 501 }
 502
 503 sub getNickInUse {
 504     if ($ident eq $param{'ircNick'}) {
 505         &status("okay, got my nick back.");
 506         return;
 507     }
 508
 509     &status("Trying to get my nick back.");
 510     &nick($param{'ircNick'});
 511
 512     &ScheduleThis(5, "getNickInUse") if (@_);
 513 }
 514
 515 sub uptimeCycle {
 516     &uptimeWriteFile();
 517
 518     &ScheduleThis(60, "uptimeCycle") if (@_);
 519 }
 520
 521 sub slashdotCycle {
 522     &Forker("slashdot", sub { &Slashdot::slashdotAnnounce(); } );
 523
 524     &ScheduleThis(60, "slashdotCycle") if (@_);
 525 }
 526
 527 sub freshmeatCycle {
 528     &Forker("freshmeat", sub { &Freshmeat::freshmeatAnnounce(); } );
 529
 530     &ScheduleThis(60, "freshmeatCycle") if (@_);
 531 }
 532
 533 sub kernelCycle {
 534     &Forker("kernel", sub { &Kernel::kernelAnnounce(); } );
 535
 536     &ScheduleThis(240, "kernelCycle") if (@_);
 537 }
 538
 539 sub wingateCheck {
 540     return unless &IsParam("wingate");
 541     return unless ($param{'wingate'} =~ /^(.*\s+)?$chan(\s+.*)?$/i);
 542
 543     ### FILE CACHE OF OFFENDING WINGATES.
 544     foreach (grep /^$host$/, @wingateBad) {
 545         &status("Wingate: RUNNING ON $host BY $who");
 546         &ban("*!*\@$host", "") if &IsParam("wingateBan");
 547
 548         next unless (&IsParam("wingateKick"));
 549         &kick($who, "", $param{'wingateKick'})
 550     }
 551
 552     ### RUN CACHE OF TRIED WINGATES.
 553     if (grep /^$host$/, @wingateCache) {
 554         push(@wingateNow, $host);       # per run.
 555         push(@wingateCache, $host);     # cache per run.
 556     } else {
 557         &DEBUG("Already scanned $host. good.");
 558     }
 559
 560     my $interval = $param{'wingateInterval'} || 60;     # seconds.
 561     return if (defined $forked{'wingate'});
 562     return if (time() - $wingaterun <= $interval);
 563     return unless (scalar(keys %wingateToDo));
 564
 565     $wingaterun = time();
 566
 567     &Forker("wingate", sub { &Wingate::Wingates(keys %wingateToDo); } );
 568     undef @wingateNow;
 569 }
 570
 571 ### TODO.
 572 sub wingateWriteFile {
 573     return unless (scalar @wingateCache);
 574
 575     my $file = "$bot_base_dir/$param{'ircUser'}.wingate";
 576     if ($bot_pid != $$) {
 577         &DEBUG("wingateWriteFile: Reorganising!");
 578
 579         open(IN, $file);
 580         while (<IN>) {
 581             chop;
 582             push(@wingateNow, $_);
 583         }
 584         close IN;
 585
 586         # very lame hack.
 587         my %hash = map { $_ => 1 } @wingateNow;
 588         @wingateNow = sort keys %hash;
 589     }
 590
 591     &DEBUG("wingateWF: writing...");
 592     open(OUT, ">$file");
 593     foreach (@wingateNow) {
 594         print OUT "$_\n";
 595     }
 596     close OUT;
 597
 598     &ScheduleThis(60, "wingateWriteFile") if (@_);
 599 }
 600
 601 1;