src/IRC/Schedulers.pl

   1 #
   2 # ProcessExtra.pl: Extensions to Process.pl
   3 #          Author: dms
   4 #         Version: v0.5 (20010124)
   5 #         Created: 20000117
   6 #
   7
   8 if (&IsParam("useStrict")) { use strict; }
   9
  10 use POSIX qw(strftime);
  11 use vars qw(%sched);
  12
  13 #
  14 # is there a point in ScheduleChecked()?
  15 # not yet... not unless we run setupSchedulers more than once.
  16 #
  17
  18 sub setupSchedulers {
  19     &VERB("Starting schedulers...",2);
  20
  21     # ONCE OFF.
  22
  23     # REPETITIVE.
  24     &uptimeLoop(1);
  25     &randomQuote(2);
  26     &randomFactoid(2);
  27     &randomFreshmeat(2);
  28     &logLoop(1);
  29     &chanlimitCheck(1);
  30     &netsplitCheck(1);  # mandatory
  31     &floodLoop(1);      # mandatory
  32     &seenFlush(1);
  33     &leakCheck(1);      # mandatory
  34     &ignoreCheck(1);    # mandatory
  35     &seenFlushOld(1);
  36     &ircCheck(1);       # mandatory
  37     &miscCheck(1);      # mandatory
  38     &shmFlush(1);       # mandatory
  39     &slashdotLoop(2);
  40     &freshmeatLoop(2);
  41     &kernelLoop(2);
  42     &wingateWriteFile(1);
  43     &factoidCheck(1);
  44
  45 #    my $count = map { exists $sched{$_}{TIME} } keys %sched;
  46     my $count   = 0;
  47     foreach (keys %sched) {
  48         next unless (exists $sched{$_}{TIME});
  49         $count++;
  50     }
  51
  52     &status("Schedulers: $count will be running.");
  53 ###    &scheduleList();
  54 }
  55
  56 sub ScheduleThis {
  57     my ($interval, $codename, @args) = @_;
  58     my $waittime = &getRandomInt($interval);
  59
  60     if (!defined $waittime) {
  61         &WARN("interval == waittime == UNDEF for $codename.");
  62         return;
  63     }
  64
  65     if (exists $sched{$codename}{RUNNING}) {
  66         &WARN("Sched for $codename already exists. forgot ScheduleChecked?");
  67         return;
  68     }
  69
  70     &VERB("Scheduling \&$codename() for ".&Time2String($waittime),3);
  71     my $retval = $conn->schedule($waittime, \&$codename, @args);
  72     $sched{$codename}{LABEL}    = $retval;
  73     $sched{$codename}{TIME}     = time()+$waittime;
  74     $sched{$codename}{RUNNING}  = 1;
  75 }
  76
  77 sub ScheduleChecked {
  78     my ($codename) = shift;
  79
  80     # what the hell is this for?
  81     if (exists $sched{$codename}{RUNNING}) {
  82 ###     &DEBUG("SC: Removed $codename.");
  83         delete $sched{$codename}{RUNNING};
  84     } else {
  85 ###     &WARN("sched $codename already removed.");
  86     }
  87 }
  88
  89 ####
  90 #### LET THE FUN BEGIN.
  91 ####
  92
  93 sub randomQuote {
  94     my $interval = &getChanConfDefault("randomQuoteInterval", 60);
  95     if (@_) {
  96         &ScheduleThis($interval, "randomQuote");
  97         &ScheduleChecked("randomQuote");
  98         return if ($_[0] eq "2");       # defer.
  99     }
 100
 101     my $line = &getRandomLineFromFile($bot_misc_dir. "/blootbot.randtext");
 102     if (!defined $line) {
 103         &ERROR("random Quote: weird error?");
 104         return;
 105     }
 106
 107     foreach ( &ChanConfList("randomQuote") ) {
 108         next unless (&validChan($_));   # ???
 109
 110         &status("sending random Quote to $_.");
 111         &action($_, "Ponders: ".$line);
 112     }
 113     ### TODO: if there were no channels, don't reschedule until channel
 114     ###         configuration is modified.
 115 }
 116
 117 sub randomFactoid {
 118     my ($key,$val);
 119     my $error = 0;
 120
 121     my $interval = &getChanConfDefault("randomFactoidInterval", 60);
 122     if (@_) {
 123         &ScheduleThis($interval, "randomFactoid");
 124         &ScheduleChecked("randomFactoid");
 125         return if ($_[0] eq "2");       # defer.
 126     }
 127
 128     while (1) {
 129         ($key,$val) = &randKey("factoids","factoid_key,factoid_value");
 130 ###     $val =~ tr/^[A-Z]/[a-z]/;       # blah is Good => blah is good.
 131         last if ($val !~ /^</);
 132         $error++;
 133         if ($error == 5) {
 134             &ERROR("rF: tried 5 times but failed.");
 135             return;
 136         }
 137     }
 138
 139     foreach ( &ChanConfList("randomFactoid") ) {
 140         next unless (&validChan($_));   # ???
 141
 142         &status("sending random Factoid to $_.");
 143         &action($_, "Thinks: \037$key\037 is $val");
 144         ### FIXME: Use &getReply() on above to format factoid properly?
 145         $good++;
 146     }
 147 }
 148
 149 sub randomFreshmeat {
 150     my $interval = &getChanConfDefault("randomFresheatInterval", 60);
 151
 152     if (@_) {
 153         &ScheduleThis($interval, "randomFreshmeat");
 154         &ScheduleChecked("randomFreshmeat");
 155         return if ($_[0] eq "2");       # defer.
 156     }
 157
 158     my @chans = &ChanConfList("randomFreshmeat");
 159     return unless (scalar @chans);
 160
 161     &Forker("freshmeat", sub {
 162         my $retval = &Freshmeat::randPackage();
 163
 164         foreach (@chans) {
 165             next unless (&validChan($_));       # ???
 166
 167             &status("sending random Freshmeat to $_.");
 168             &say($_, $line);
 169         }
 170     } );
 171 }
 172
 173 sub logLoop {
 174     if (@_) {
 175         &ScheduleThis(60, "logLoop");
 176         &ScheduleChecked("logLoop");
 177         return if ($_[0] eq "2");       # defer.
 178     }
 179
 180     return unless (defined fileno LOG);
 181     return unless (&IsParam("logfile"));
 182     return unless (&IsParam("maxLogSize"));
 183
 184     ### check if current size is too large.
 185     if ( -s $file{log} > $param{'maxLogSize'}) {
 186         my $date = sprintf("%04d%02d%02d", (localtime)[5,4,3]);
 187         $file{log} = $param{'logfile'} ."-". $date;
 188         &status("cycling log file.");
 189
 190         if ( -e $file{log}) {
 191             my $i = 1;
 192             my $newlog;
 193             while () {
 194                 $newlog = $file{log}."-".$i;
 195                 last if (! -e $newlog);
 196                 $i++;
 197             }
 198             $file{log} = $newlog;
 199         }
 200
 201         &closeLog();
 202         system("/bin/mv '$param{'logfile'}' '$file{log}'");
 203         &compress($file{log});
 204         &openLog();
 205         &status("cycling log file.");
 206     }
 207
 208     ### check if all the logs exceed size.
 209     my $logdir = "$bot_base_dir/log/";
 210     if (opendir(LOGS, $logdir)) {
 211         my $tsize = 0;
 212         my (%age, %size);
 213
 214         while (defined($_ = readdir LOGS)) {
 215             my $logfile         = "$logdir/$_";
 216
 217             next unless ( -f $logfile);
 218             my $size            = -s $logfile;
 219             my $age             = (stat $logfile)[9];
 220
 221             $age{$age}          = $logfile;
 222             $size{$logfile}     = $size;
 223
 224             $tsize              += $size;
 225         }
 226         closedir LOGS;
 227
 228         my $delete      = 0;
 229         while ($tsize > $param{'maxLogSize'}) {
 230             &status("LOG: current size > max ($tsize > $param{'maxLogSize'})");
 231             my $oldest  = (sort {$a <=> $b} keys %age)[0];
 232             &status("LOG: unlinking $age{$oldest}.");
 233             unlink $age{$oldest};
 234             $tsize      -= $oldest;
 235             $delete++;
 236         }
 237
 238         ### TODO: add how many b,kb,mb removed?
 239         &status("LOG: removed $delete logs.") if ($delete);
 240     } else {
 241         &WARN("could not open dir $logdir");
 242     }
 243
 244 }
 245
 246 sub seenFlushOld {
 247     if (@_) {
 248         &ScheduleThis(1440, "seenFlushOld");
 249         &ScheduleChecked("seenFlushOld");
 250         return if ($_[0] eq "2");       # defer.
 251     }
 252
 253     # is this global-only?
 254     return unless (&IsChanConf("seen") > 0);
 255     return unless (&IsChanConf("seenFlushInterval") > 0);
 256
 257     my $max_time = ($chanconf{_default}{'seenMaxDays'} || 30)
 258                                 *60*60*24; # global.
 259     my $delete   = 0;
 260
 261     if ($param{'DBType'} =~ /^pg|postgres|mysql/i) {
 262         my $query = "SELECT nick,time FROM seen GROUP BY nick HAVING UNIX_TIMESTAMP() - time > $max_time";
 263         my $sth = $dbh->prepare($query);
 264         $sth->execute;
 265
 266         while (my @row = $sth->fetchrow_array) {
 267             my ($nick,$time) = @row;
 268
 269             &dbDel("seen","nick",$nick);
 270             $delete++;
 271         }
 272         $sth->finish;
 273     } elsif ($param{'DBType'} =~ /^dbm/i) {
 274         my $time = time();
 275
 276         foreach (keys %seen) {
 277             my $delta_time = $time - &dbGet("seen", "NULL", $_, "time");
 278             next unless ($delta_time > $max_time);
 279
 280             &DEBUG("seenFlushOld: ".&Time2String($delta_time) );
 281             delete $seen{$_};
 282             $delete++;
 283         }
 284     } else {
 285         &FIXME("seenFlushOld: for PG/NO-DB.");
 286     }
 287     &VERB("SEEN deleted $delete seen entries.",2);
 288
 289 }
 290
 291 sub chanlimitCheck {
 292     if (@_) {
 293         my $interval = &getChanConf("chanlimitcheckInterval") || 10;
 294         &ScheduleThis($interval, "chanlimitCheck");
 295         &ScheduleChecked("chanlimitCheck");
 296         return if ($_[0] eq "2");
 297     }
 298
 299     foreach ( &ChanConfList("chanlimitcheck") ) {
 300         next unless (&validChan($_));   # ???
 301
 302         my $limitplus   = &getChanConf("chanlimitcheckPlus",$_) || 5;
 303         my $newlimit    = scalar(keys %{$channels{$_}{''}}) + $limitplus;
 304         my $limit       = $channels{$_}{'l'};
 305
 306         if (scalar keys %{$channels{$_}{''}} > $limit) {
 307             &status("LIMIT: set too low!!! FIXME");
 308             ### run NAMES again and flush it.
 309         }
 310
 311         next unless (!defined $limit or $limit != $newlimit);
 312
 313         if (!exists $channels{$_}{'o'}{$ident}) {
 314             &ERROR("chanlimitcheck: dont have ops on $_.");
 315             next;
 316         }
 317         &rawout("MODE $_ +l $newlimit");
 318     }
 319
 320 }
 321
 322 sub netsplitCheck {
 323     my ($s1,$s2);
 324
 325     if (@_) {
 326         &ScheduleThis(30, "netsplitCheck");
 327         &ScheduleChecked("netsplitCheck");
 328         return if ($_[0] eq "2");
 329     }
 330
 331     foreach $s1 (keys %netsplitservers) {
 332         foreach $s2 (keys %{$netsplitservers{$s1}}) {
 333             if (time() - $netsplitservers{$s1}{$s2} > 3600) {
 334                 &status("netsplit between $s1 and $s2 appears to be stale.");
 335                 delete $netsplitservers{$s1}{$s2};
 336             }
 337         }
 338     }
 339
 340     # %netsplit hash checker.
 341     foreach (keys %netsplit) {
 342         if (&IsNickInAnyChan($_)) {
 343             &DEBUG("netsplitC: $_ is in some chan; removing from netsplit list.");
 344             delete $netsplit{$_};
 345         }
 346         next unless (time() - $netsplit{$_} > 60*60*2); # 2 hours.
 347         next if (&IsNickInAnyChan($_));
 348
 349         &DEBUG("netsplitC: $_ didn't come back from netsplit in 2 hours; removing from netsplit list.");
 350         delete $netsplit{$_};
 351     }
 352 }
 353
 354 sub floodLoop {
 355     my $delete   = 0;
 356     my $who;
 357
 358     if (@_) {
 359         &ScheduleThis(60, "floodLoop"); # minutes.
 360         &ScheduleChecked("floodLoop");
 361         return if ($_[0] eq "2");
 362     }
 363
 364     my $time            = time();
 365     my $interval        = &getChanConfDefault("floodCycle",60);
 366
 367     foreach $who (keys %flood) {
 368         foreach (keys %{$flood{$who}}) {
 369             if (!exists $flood{$who}{$_}) {
 370                 &WARN("flood{$who}{$_} undefined?");
 371                 next;
 372             }
 373
 374             if ($time - $flood{$who}{$_} > $interval) {
 375                 delete $flood{$who}{$_};
 376                 $delete++;
 377             }
 378         }
 379     }
 380     &VERB("floodLoop: deleted $delete items.",2);
 381 }
 382
 383 sub seenFlush {
 384     my %stats;
 385     my $nick;
 386     my $flushed         = 0;
 387     $stats{'count_old'} = &countKeys("seen") || 0;
 388     $stats{'new'}       = 0;
 389     $stats{'old'}       = 0;
 390
 391     if (@_) {
 392         my $interval = &getChanConfDefault("seenFlushInterval", 60);
 393         &ScheduleThis($interval, "seenFlush");
 394         &ScheduleChecked("seenFlush");
 395         return if ($_[0] eq "2");
 396     }
 397
 398     if ($param{'DBType'} =~ /^mysql|pg|postgres/i) {
 399         foreach $nick (keys %seencache) {
 400             my $exists = &dbGet("seen","nick", $nick, "nick");
 401
 402             if (defined $exists and $exists) {
 403                 &dbUpdate("seen", "nick", $nick, (
 404                         "time" => $seencache{$nick}{'time'},
 405                         "host" => $seencache{$nick}{'host'},
 406                         "channel" => $seencache{$nick}{'chan'},
 407                         "message" => $seencache{$nick}{'msg'},
 408                 ) );
 409                 $stats{'old'}++;
 410             } else {
 411                 my $retval = &dbInsert("seen", $nick, (
 412                         "nick" => $seencache{$nick}{'nick'},
 413                         "time" => $seencache{$nick}{'time'},
 414                         "host" => $seencache{$nick}{'host'},
 415                         "channel" => $seencache{$nick}{'chan'},
 416                         "message" => $seencache{$nick}{'msg'},
 417                 ) );
 418                 $stats{'new'}++;
 419
 420                 ### TODO: put bad nick into a list and don't do it again!
 421                 &FIXME("Should never happen! (nick => $nick)") if !$retval;
 422             }
 423
 424             delete $seencache{$nick};
 425             $flushed++;
 426         }
 427
 428     } elsif ($param{'DBType'} =~ /^dbm/i) {
 429
 430         foreach $nick (keys %seencache) {
 431             my $retval = &dbInsert("seen", $nick, (
 432                 "nick" => $seencache{$nick}{'nick'},
 433                 "time" => $seencache{$nick}{'time'},
 434                 "host" => $seencache{$nick}{'host'},
 435                 "channel" => $seencache{$nick}{'chan'},
 436                 "message" => $seencache{$nick}{'msg'},
 437             ) );
 438
 439             ### TODO: put bad nick into a list and don't do it again!
 440             &FIXME("Should never happen! (nick => $nick)") if !$retval;
 441
 442             delete $seencache{$nick};
 443             $flushed++;
 444         }
 445     } else {
 446         &DEBUG("seenFlush: NO VALID FACTOID SUPPORT?");
 447     }
 448
 449     &status("Flushed $flushed seen entries.")           if ($flushed);
 450     &VERB(sprintf("  new seen: %03.01f%% (%d/%d)",
 451         $stats{'new'}*100/$stats{'count_old'},
 452         $stats{'new'}, $stats{'count_old'} ), 2)        if ($stats{'new'});
 453     &VERB(sprintf("  now seen: %3.1f%% (%d/%d)",
 454         $stats{'old'}*100/&countKeys("seen"),
 455         $stats{'old'}, &countKeys("seen") ), 2)         if ($stats{'old'});
 456
 457     &WARN("scalar keys seenflush != 0!")        if (scalar keys %seenflush);
 458
 459 }
 460
 461 sub leakCheck {
 462     my ($blah1,$blah2);
 463     my $count = 0;
 464
 465     if (@_) {
 466         &ScheduleThis(60, "leakCheck");
 467         &ScheduleChecked("leakCheck");
 468         return if ($_[0] eq "2");
 469     }
 470
 471     # flood.
 472     foreach $blah1 (keys %flood) {
 473         foreach $blah2 (keys %{$flood{$blah1}}) {
 474             $count += scalar(keys %{$flood{$blah1}{$blah2}});
 475         }
 476     }
 477     &VERB("\%flood has $count total keys.",2);
 478
 479     my $chan;
 480     foreach $chan (grep /[A-Z]/, keys %channels) {
 481         &DEBUG("leak: chan => '$chan'.");
 482         my ($i,$j);
 483         foreach $i (keys %{$channels{$chan}}) {
 484             foreach (keys %{$channels{$chan}{$i}}) {
 485                 &DEBUG("leak:   \$channels{$chan}{$i}{$_} ...");
 486             }
 487         }
 488     }
 489
 490     my $delete  = 0;
 491     foreach (keys %nuh) {
 492         next if (&IsNickInAnyChan($_));
 493         delete $nuh{$_};
 494         $delete++;
 495     }
 496
 497     &DEBUG("$delete nuh{} items deleted; now have ".
 498                                 scalar(keys %nuh) ) if ($delete);
 499 }
 500
 501 sub ignoreCheck {
 502     if (@_) {
 503         &ScheduleThis(60, "ignoreCheck");
 504         &ScheduleChecked("ignoreCheck");
 505     }
 506
 507     my $time    = time();
 508     my $count   = 0;
 509
 510     foreach (keys %ignore) {
 511         my $chan = $_;
 512
 513         foreach (keys %{ $ignore{$chan} }) {
 514             my @array = @{ $ignore{$chan}{$_} };
 515
 516             next unless ($array[0] and $time > $array[0]);
 517
 518             delete $ignore{$chan}{$_};
 519             &status("ignore: $_/$chan has expired.");
 520             $count++;
 521         }
 522     }
 523     &VERB("ignore: $count items deleted.",2);
 524 }
 525
 526 sub ircCheck {
 527     my @array = grep !/^_default$/, keys %chanconf;
 528     my $iconf = scalar(@array);
 529     my $inow  = scalar(keys %channels);
 530     if ($iconf > 2 and $inow * 2 <= $iconf) {
 531         &FIXME("ircCheck: current channels * 2 <= config channels. FIXME.");
 532     }
 533
 534     # chanserv ops.
 535     foreach ( &ChanConfList("chanServ_ops") ) {
 536         next if (exists $channels{$chan}{'o'}{$ident});
 537
 538         &status("ChanServ ==> Requesting ops for $chan.");
 539         &rawout("PRIVMSG ChanServ :OP $chan $ident");
 540     }
 541
 542     if (!$conn->connected and time - $msgtime > 3600) {
 543         &WARN("ircCheck: no msg for 3600 and disco'd! reconnecting!");
 544         $msgtime = time();      # just in case.
 545         &ircloop();
 546     }
 547
 548     if ($ident !~ /^\Q$param{ircNick}\E$/) {
 549         &WARN("ircCheck: ident($ident) != param{ircNick}($param{IrcNick}).");
 550         ### TODO: schedule check for own nick if taken?
 551     }
 552
 553     &joinNextChan();
 554         # if scalar @joinnext => join more channels
 555         # else check for chanserv.
 556
 557     if (grep /^\s*$/, keys %channels) {
 558         &WARN("we have a NULL chan in hash channels? removing!");
 559         delete $channels{''};   # ???
 560         &DEBUG("channels now:");
 561         foreach (keys %channels) {
 562             &status("  $_");
 563         }
 564         &DEBUG("channels END");
 565     }
 566
 567     ### USER FILE.
 568     if ($utime_userfile > $wtime_userfile and time() - $wtime_userfile > 3600) {
 569         &writeUserFile();
 570         $wtime_userfile = time();
 571     }
 572     ### CHAN FILE.
 573     if ($utime_chanfile > $wtime_chanfile and time() - $wtime_chanfile > 3600) {
 574         &writeChanFile();
 575         $wtime_chanfile = time();
 576     }
 577
 578     &ScheduleThis(240, "ircCheck") if (@_);
 579 }
 580
 581 sub miscCheck {
 582     &ScheduleThis(240, "miscCheck") if (@_);
 583
 584     # SHM check.
 585     my @ipcs;
 586     if ( -x "/usr/bin/ipcs") {
 587         @ipcs = `/usr/bin/ipcs`;
 588     } else {
 589         &WARN("ircCheck: no 'ipcs' binary.");
 590         return;
 591     }
 592
 593     # shmid stale remove.
 594     foreach (@ipcs) {
 595         chop;
 596
 597         # key, shmid, owner, perms, bytes, nattch
 598         next unless (/^(0x\d+) (\d+)\s+(\S+)\s+(\d+)\s+(\d+)\s+/);
 599
 600         my ($shmid, $size) = ($2,$5);
 601         next unless ($shmid != $shm and $size == 2000);
 602
 603 ###     &status("SHM: nuking shmid $shmid");
 604 ###     system("/usr/bin/ipcrm shm $shmid >/dev/null");
 605     }
 606
 607     ### check modules if they've been modified. might be evil.
 608     &reloadAllModules();
 609 }
 610
 611 sub shmFlush {
 612     if (@_) {
 613         &ScheduleThis(5, "shmFlush");
 614         &ScheduleChecked("shmFlush");
 615         return if ($_[0] eq "2");
 616     }
 617
 618     my $shmmsg = &shmRead($shm);
 619     $shmmsg =~ s/\0//g;         # remove padded \0's.
 620
 621     return if ($$ != $::bot_pid); # fork protection.
 622
 623     foreach (split '\|\|', $shmmsg) {
 624         &VERB("shm: Processing '$_'.",2);
 625
 626         if (/^DCC SEND (\S+) (\S+)$/) {
 627             my ($nick,$file) = ($1,$2);
 628             if (exists $dcc{'SEND'}{$who}) {
 629                 &msg($nick,"DCC already active.");
 630             } else {
 631                 &DEBUG("shm: dcc sending $2 to $1.");
 632                 $conn->new_send($1,$2);
 633                 $dcc{'SEND'}{$who} = time();
 634             }
 635         } elsif (/^SET FORKPID (\S+) (\S+)/) {
 636             $forked{$1}{PID} = $2;
 637         } elsif (/^DELETE FORK (\S+)$/) {
 638             delete $forked{$1};
 639         } elsif (/^EVAL (.*)$/) {
 640             &DEBUG("evaling '$1'.");
 641             eval $1;
 642         } else {
 643             &DEBUG("shm: unknown msg. ($_)");
 644         }
 645     }
 646
 647     &shmWrite($shm,"") if ($shmmsg ne "");
 648 }
 649
 650 ### this is semi-scheduled
 651 sub getNickInUse {
 652     if ($ident eq $param{'ircNick'}) {
 653         &status("okay, got my nick back.");
 654         return;
 655     }
 656
 657     &status("Trying to get my nick back.");
 658     &nick( $param{'ircNick'} );
 659
 660     &ScheduleThis(30, "getNickInUse") if (@_);
 661 }
 662
 663 sub uptimeLoop {
 664     if (@_) {
 665         &ScheduleThis(60, "uptimeLoop");
 666         &ScheduleChecked("uptimeLoop");
 667     }
 668
 669     &uptimeWriteFile();
 670 }
 671
 672 sub slashdotLoop {
 673     &ScheduleThis(60, "slashdotLoop") if (@_);
 674     &ScheduleChecked("slashdotLoop");
 675     return if ($_[0] eq "2");
 676
 677     my @chans = &ChanConfList("slashdotAnnounce");
 678     return unless (scalar @chans);
 679
 680     &Forker("slashdot", sub {
 681         my @data = &Slashdot::slashdotAnnounce();
 682
 683         foreach (@chans) {
 684             next unless (&::validChan($_));
 685
 686             &::status("sending slashdot update to $_.");
 687             my $c = $_;
 688             foreach (@data) {
 689                 &notice($c, "Slashdot: $_");
 690             }
 691         }
 692     } );
 693 }
 694
 695 sub freshmeatLoop {
 696     if (@_) {
 697         &ScheduleThis(60, "freshmeatLoop");
 698         &ScheduleChecked("freshmeatLoop");
 699         return if ($_[0] eq "2");
 700     }
 701
 702     my @chans = &ChanConfList("freshmeatAnnounce");
 703     return unless (scalar @chans);
 704
 705     &Forker("freshmeat", sub {
 706         my $data = &Freshmeat::freshmeatAnnounce();
 707
 708         foreach (@chans) {
 709             next unless (&::validChan($_));
 710
 711             &::status("sending freshmeat update to $_.");
 712             &msg($_, $data);
 713         }
 714     } );
 715 }
 716
 717 sub kernelLoop {
 718     if (@_) {
 719         &ScheduleThis(240, "kernelLoop");
 720         &ScheduleChecked("kernelLoop");
 721         return if ($_[0] eq "2");
 722     }
 723
 724     my @chans = &ChanConfList("kernelAnnounce");
 725     return unless (scalar @chans);
 726
 727     &Forker("kernel", sub {
 728         my @data = &Kernel::kernelAnnounce();
 729
 730         foreach (@chans) {
 731             next unless (&::validChan($_));
 732
 733             &::status("sending kernel update to $_.");
 734             my $c = $_;
 735             foreach (@data) {
 736                 &notice($c, "Kernel: $_");
 737             }
 738         }
 739     } );
 740 }
 741
 742 sub wingateCheck {
 743     return unless &IsChanConf("wingate");
 744
 745     ### FILE CACHE OF OFFENDING WINGATES.
 746     foreach (grep /^$host$/, @wingateBad) {
 747         &status("Wingate: RUNNING ON $host BY $who");
 748         &ban("*!*\@$host", "") if &IsChanConf("wingateBan");
 749
 750         my $reason      = &getChanConf("wingateKick");
 751
 752         next unless ($reason);
 753         &kick($who, "", $reason)
 754     }
 755
 756     ### RUN CACHE OF TRIED WINGATES.
 757     if (grep /^$host$/, @wingateCache) {
 758         push(@wingateNow, $host);       # per run.
 759         push(@wingateCache, $host);     # cache per run.
 760     } else {
 761         &DEBUG("Already scanned $host. good.");
 762     }
 763
 764     my $interval = &getChanConfDefault("wingateInterval", 60); # seconds.
 765     return if (defined $forked{'wingate'});
 766     return if (time() - $wingaterun <= $interval);
 767     return unless (scalar(keys %wingateToDo));
 768
 769     $wingaterun = time();
 770
 771     &Forker("wingate", sub { &Wingate::Wingates(keys %wingateToDo); } );
 772     undef @wingateNow;
 773 }
 774
 775 ### TODO.
 776 sub wingateWriteFile {
 777     return unless (scalar @wingateCache);
 778
 779     my $file = "$bot_base_dir/$param{'ircUser'}.wingate";
 780     if ($bot_pid != $$) {
 781         &DEBUG("wingateWriteFile: Reorganising!");
 782
 783         open(IN, $file);
 784         while (<IN>) {
 785             chop;
 786             push(@wingateNow, $_);
 787         }
 788         close IN;
 789
 790         # very lame hack.
 791         my %hash = map { $_ => 1 } @wingateNow;
 792         @wingateNow = sort keys %hash;
 793     }
 794
 795     &DEBUG("wingateWF: writing...");
 796     open(OUT, ">$file");
 797     foreach (@wingateNow) {
 798         print OUT "$_\n";
 799     }
 800     close OUT;
 801
 802     &ScheduleThis(60, "wingateWriteFile") if (@_);
 803 }
 804
 805 sub factoidCheck {
 806     my @list = &searchTable("factoids", "factoid_key", "factoid_key", " #DEL#");
 807     my $stale = &getChanConfDefault("factoidDeleteDelay", 7)*60*60*24;
 808
 809     foreach (@list) {
 810         my $age = &getFactInfo($_, "modified_time");
 811         next unless (time() - $age > $stale);
 812
 813         my $fix = $_;
 814         $fix =~ s/ #DEL#$//g;
 815         &VERB("safedel: Removing $fix for good.",2);
 816         &delFactoid($_);
 817     }
 818
 819     &ScheduleThis(1440, "factoidCheck") if (@_);
 820 }
 821
 822 sub dccStatus {
 823     my $time = strftime("%H:%M", localtime(time()) );
 824
 825     return unless (scalar keys %{ $DCC{CHAT} });
 826
 827     foreach (keys %channels) {
 828         &DCCBroadcast("[$time] $_: $users members ($chops chops), $bans bans","+o");
 829     }
 830
 831     &ScheduleThis(10, "dccStatus") if (@_);
 832 }
 833
 834 sub schedulerSTUB {
 835
 836     &ScheduleThis(TIME_IN_MINUTES, "FUNCTION") if (@_);
 837 }
 838
 839 sub scheduleList {
 840     ###
 841     # custom:
 842     #   a - time == now.
 843     #   b - weird time.
 844     ###
 845
 846     &DEBUG("sched:");
 847     foreach (keys %{ $irc->{_queue} }) {
 848         my $q = $_;
 849
 850         my $sched;
 851         foreach (keys %sched) {
 852             next unless ($q eq $sched{$_});
 853             $sched = $_;
 854             last;
 855         }
 856
 857         my $time = $irc->{_queue}->{$q}->[0] - time();
 858
 859         if (defined $sched) {
 860             &DEBUG("   $sched($q): ".&Time2String($time) );
 861         } else {
 862             &DEBUG("   NULL($q): ".&Time2String($time) );
 863         }
 864     }
 865
 866     &DEBUG("end of sList.");
 867 }
 868
 869 sub getChanConfDefault {
 870     my($what, $default, $chan) = @_;
 871
 872     if (exists $param{$what}) {
 873         &DEBUG("backward-compat: found param{$what} instead.");
 874         return $param{$what};
 875     }
 876
 877     my $val = &getChanConf($what, $chan);
 878     if (defined $val) {
 879         return $val;
 880     }
 881     $param{$what}       = $default;
 882     &status("gCCD: not configured; setting param{$what} = $default");
 883     ### TODO: set some vars?
 884     return $default;
 885 }
 886
 887 1;