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 sub setupSchedulers {
  14     &VERB("Starting schedulers...",2);
  15
  16     # ONCE OFF.
  17
  18     # REPETITIVE.
  19     # 1 for run straight away, 2 for on next-run.
  20     &uptimeLoop(1);
  21     &randomQuote(2);
  22     &randomFactoid(2);
  23     &randomFreshmeat(2);
  24     &logLoop(1);
  25     &chanlimitCheck(1);
  26     &netsplitCheck(1);  # mandatory
  27     &floodLoop(1);      # mandatory
  28     &seenFlush(2);
  29     &leakCheck(2);      # mandatory
  30     &ignoreCheck(1);    # mandatory
  31     &seenFlushOld(2);
  32     &ircCheck(1);       # mandatory
  33     &miscCheck(1);      # mandatory
  34     &shmFlush(1);       # mandatory
  35     &slashdotLoop(2);
  36     &freshmeatLoop(2);
  37     &kernelLoop(2);
  38     &wingateWriteFile(2);
  39     &factoidCheck(2);
  40     &newsFlush(1);
  41
  42 #    my $count = map { exists $sched{$_}{TIME} } keys %sched;
  43     my $count   = 0;
  44     foreach (keys %sched) {
  45 #       next unless (exists $sched{$_}{TIME});
  46         my $time = $sched{$_}{TIME};
  47         next unless (defined $time and $time > time());
  48
  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     my $time = $sched{$codename}{TIME};
  66     if (defined $time and $time > time()) {
  67         &WARN("Sched for $codename already exists.");
  68         return;
  69     }
  70
  71 #    &VERB("Scheduling \&$codename() for ".&Time2String($waittime),3);
  72
  73     my $retval = $conn->schedule($waittime, \&$codename, @args);
  74     $sched{$codename}{LABEL}    = $retval;
  75     $sched{$codename}{TIME}     = time()+$waittime;
  76     $sched{$codename}{RUNNING}  = 1;
  77 }
  78
  79 ####
  80 #### LET THE FUN BEGIN.
  81 ####
  82
  83 sub randomQuote {
  84     my $interval = &getChanConfDefault("randomQuoteInterval", 60);
  85     if (@_) {
  86         &ScheduleThis($interval, "randomQuote");
  87         return if ($_[0] eq "2");       # defer.
  88     } else {
  89         delete $sched{"randomQuote"}{RUNNING};
  90     }
  91
  92     my $line = &getRandomLineFromFile($bot_misc_dir. "/blootbot.randtext");
  93     if (!defined $line) {
  94         &ERROR("random Quote: weird error?");
  95         return;
  96     }
  97
  98     foreach ( &ChanConfList("randomQuote") ) {
  99         next unless (&validChan($_));
 100
 101         &status("sending random Quote to $_.");
 102         &action($_, "Ponders: ".$line);
 103     }
 104     ### TODO: if there were no channels, don't reschedule until channel
 105     ###         configuration is modified.
 106 }
 107
 108 sub randomFactoid {
 109     my ($key,$val);
 110     my $error = 0;
 111
 112     my $interval = &getChanConfDefault("randomFactoidInterval", 60);
 113     if (@_) {
 114         &ScheduleThis($interval, "randomFactoid");
 115         return if ($_[0] eq "2");       # defer.
 116     } else {
 117         delete $sched{"randomFactoid"}{RUNNING};
 118     }
 119
 120     while (1) {
 121         ($key,$val) = &randKey("factoids","factoid_key,factoid_value");
 122 ###     $val =~ tr/^[A-Z]/[a-z]/;       # blah is Good => blah is good.
 123         last if (defined $val and $val !~ /^</);
 124
 125         $error++;
 126         if ($error == 5) {
 127             &ERROR("rF: tried 5 times but failed.");
 128             return;
 129         }
 130     }
 131
 132     foreach ( &ChanConfList("randomFactoid") ) {
 133         next unless (&validChan($_));
 134
 135         &status("sending random Factoid to $_.");
 136         &action($_, "Thinks: \037$key\037 is $val");
 137         ### FIXME: Use &getReply() on above to format factoid properly?
 138         $good++;
 139     }
 140 }
 141
 142 sub randomFreshmeat {
 143     my $interval = &getChanConfDefault("randomFresheatInterval", 60);
 144
 145     if (@_) {
 146         &ScheduleThis($interval, "randomFreshmeat");
 147         return if ($_[0] eq "2");       # defer.
 148     } else {
 149         delete $sched{"randomFreshmeat"}{RUNNING};
 150     }
 151
 152     my @chans = &ChanConfList("randomFreshmeat");
 153     return unless (scalar @chans);
 154
 155     &Forker("freshmeat", sub {
 156         my $retval = &Freshmeat::randPackage();
 157
 158         foreach (@chans) {
 159             next unless (&validChan($_));
 160
 161             &status("sending random Freshmeat to $_.");
 162             &say($_, $line);
 163         }
 164     } );
 165 }
 166
 167 sub logLoop {
 168     if (@_) {
 169         &ScheduleThis(60, "logLoop");
 170         return if ($_[0] eq "2");       # defer.
 171     } else {
 172         delete $sched{"logLoop"}{RUNNING};
 173     }
 174
 175     return unless (defined fileno LOG);
 176     return unless (&IsParam("logfile"));
 177     return unless (&IsParam("maxLogSize"));
 178
 179     ### check if current size is too large.
 180     if ( -s $file{log} > $param{'maxLogSize'}) {
 181         my $date = sprintf("%04d%02d%02d", (localtime)[5,4,3]);
 182         $file{log} = $param{'logfile'} ."-". $date;
 183         &status("cycling log file.");
 184
 185         if ( -e $file{log}) {
 186             my $i = 1;
 187             my $newlog;
 188             while () {
 189                 $newlog = $file{log}."-".$i;
 190                 last if (! -e $newlog);
 191                 $i++;
 192             }
 193             $file{log} = $newlog;
 194         }
 195
 196         &closeLog();
 197         CORE::system("/bin/mv '$param{'logfile'}' '$file{log}'");
 198         &compress($file{log});
 199         &openLog();
 200         &status("cycling log file.");
 201     }
 202
 203     ### check if all the logs exceed size.
 204     my $logdir = "$bot_base_dir/log/";
 205     if (opendir(LOGS, $logdir)) {
 206         my $tsize = 0;
 207         my (%age, %size);
 208
 209         while (defined($_ = readdir LOGS)) {
 210             my $logfile         = "$logdir/$_";
 211
 212             next unless ( -f $logfile);
 213             my $size            = -s $logfile;
 214             my $age             = (stat $logfile)[9];
 215
 216             $age{$age}          = $logfile;
 217             $size{$logfile}     = $size;
 218
 219             $tsize              += $size;
 220         }
 221         closedir LOGS;
 222
 223         my $delete      = 0;
 224         while ($tsize > $param{'maxLogSize'}) {
 225             &status("LOG: current size > max ($tsize > $param{'maxLogSize'})");
 226             my $oldest  = (sort {$a <=> $b} keys %age)[0];
 227             &status("LOG: unlinking $age{$oldest}.");
 228             unlink $age{$oldest};
 229             $tsize      -= $oldest;
 230             $delete++;
 231         }
 232
 233         ### TODO: add how many b,kb,mb removed?
 234         &status("LOG: removed $delete logs.") if ($delete);
 235     } else {
 236         &WARN("could not open dir $logdir");
 237     }
 238
 239 }
 240
 241 sub seenFlushOld {
 242     if (@_) {
 243         &ScheduleThis(1440, "seenFlushOld");
 244         return if ($_[0] eq "2");       # defer.
 245     } else {
 246         delete $sched{"seenFlushOld"}{RUNNING};
 247     }
 248
 249     # is this global-only?
 250     return unless (&IsChanConf("seen") > 0);
 251     return unless (&IsChanConf("seenFlushInterval") > 0);
 252
 253     # global setting. does not make sense for per-channel.
 254     my $max_time = &getChanConfDefault("seenMaxDays", 30) *60*60*24;
 255     my $delete   = 0;
 256
 257     if ($param{'DBType'} =~ /^pg|postgres|mysql/i) {
 258         my $query = "SELECT nick,time FROM seen GROUP BY nick HAVING UNIX_TIMESTAMP() - time > $max_time";
 259         my $sth = $dbh->prepare($query);
 260         $sth->execute;
 261
 262         while (my @row = $sth->fetchrow_array) {
 263             my ($nick,$time) = @row;
 264
 265             &dbDel("seen","nick",$nick);
 266             $delete++;
 267         }
 268         $sth->finish;
 269     } elsif ($param{'DBType'} =~ /^dbm/i) {
 270         my $time = time();
 271
 272         foreach (keys %seen) {
 273             my $delta_time = $time - &dbGet("seen", "NULL", $_, "time");
 274             next unless ($delta_time > $max_time);
 275
 276             &DEBUG("seenFlushOld: ".&Time2String($delta_time) );
 277             delete $seen{$_};
 278             $delete++;
 279         }
 280     } else {
 281         &FIXME("seenFlushOld: for PG/NO-DB.");
 282     }
 283     &VERB("SEEN deleted $delete seen entries.",2);
 284
 285 }
 286
 287 sub newsFlush {
 288     if (@_) {
 289         &ScheduleThis(1440, "newsFlush");
 290         return if ($_[0] eq "2");       # defer.
 291     } else {
 292         delete $sched{"newsFlush"}{RUNNING};
 293     }
 294
 295     return unless (&IsChanConf("news") > 0);
 296
 297     my $delete  = 0;
 298     my $oldest  = time();
 299     foreach $chan (keys %::news) {
 300         foreach $item (keys %{ $::news{$chan} }) {
 301             my $t = $::news{$chan}{$item}{Expire};
 302
 303             my $tadd    = $::news{$chan}{$item}{Time};
 304             $oldest     = $tadd if ($oldest > $tadd);
 305
 306             next if ($t == 0 or $t == -1);
 307             if ($t < 1000) {
 308                 &status("newsFlush: Fixed Expire time for $chan/$item, should not happen anyway.");
 309                 $::news{$chan}{$item}{Expire} = time() + $t*60*60*24;
 310                 next;
 311             }
 312
 313             next unless (time() > $t);
 314             # todo: show how old it was.
 315             delete $::news{$chan}{$item};
 316             &VERB("NEWS: deleted '$item'", 2);
 317             $delete++;
 318         }
 319     }
 320
 321     # todo: flush users aswell.
 322     my $duser   = 0;
 323     foreach $chan (keys %::newsuser) {
 324         foreach (keys %{ $::newsuser{$chan} }) {
 325             my $t = $::newsuser{$chan}{$_};
 326             if (!defined $t or $t < 1000) {
 327                 &DEBUG("something wrong with newsuser{$chan}{$_} => $t");
 328                 next;
 329             }
 330
 331             next unless ($oldest > $t);
 332
 333             delete $::newsuser{$chan}{$_};
 334             $duser++;
 335         }
 336     }
 337
 338 #    &VERB("NEWS deleted $delete seen entries.",2);
 339     &status("NEWS deleted: $delete news entries; $duser user cache.");
 340
 341     &News::writeNews();
 342 }
 343
 344 sub chanlimitCheck {
 345     my $interval = &getChanConfDefault("chanlimitcheckInterval", 10);
 346
 347     if (@_) {
 348         &ScheduleThis($interval, "chanlimitCheck");
 349         return if ($_[0] eq "2");
 350     } else {
 351         delete $sched{"chanlimitCheck"}{RUNNING};
 352     }
 353
 354     foreach $chan ( &ChanConfList("chanlimitcheck") ) {
 355         next unless (&validChan($chan));
 356
 357         my $limitplus   = &getChanConfDefault("chanlimitcheckPlus", 5, $chan);
 358         my $newlimit    = scalar(keys %{$channels{$chan}{''}}) + $limitplus;
 359         my $limit       = $channels{$chan}{'l'};
 360
 361         if (defined $limit and scalar keys %{$channels{$chan}{''}} > $limit) {
 362             &FIXME("LIMIT: set too low!!! FIXME");
 363             ### run NAMES again and flush it.
 364         }
 365
 366         next unless (!defined $limit or $limit != $newlimit);
 367
 368         if (!exists $channels{$chan}{'o'}{$ident}) {
 369             &status("ChanLimit: dont have ops on $chan.") unless (exists $cache{warn}{chanlimit}{$chan});
 370             $cache{warn}{chanlimit}{$chan} = 1;
 371             ### TODO: check chanserv?
 372             next;
 373         }
 374         delete $cache{warn}{chanlimit}{$chan};
 375
 376         if (!defined $limit) {
 377             &status("ChanLimit: setting for first time or from netsplit, for $chan");
 378         }
 379
 380         &rawout("MODE $chan +l $newlimit");
 381     }
 382 }
 383
 384 sub netsplitCheck {
 385     my ($s1,$s2);
 386
 387     if (@_) {
 388         &ScheduleThis(30, "netsplitCheck");
 389         return if ($_[0] eq "2");
 390     } else {
 391         delete $sched{"netsplitCheck"}{RUNNING};
 392     }
 393
 394     foreach $s1 (keys %netsplitservers) {
 395         foreach $s2 (keys %{$netsplitservers{$s1}}) {
 396             if (time() - $netsplitservers{$s1}{$s2} > 3600) {
 397                 &status("netsplit between $s1 and $s2 appears to be stale.");
 398                 delete $netsplitservers{$s1}{$s2};
 399             }
 400         }
 401     }
 402
 403     # %netsplit hash checker.
 404     my $count   = scalar keys %netsplit;
 405     foreach (keys %netsplit) {
 406         if (&IsNickInAnyChan($_)) {
 407             &DEBUG("netsplitC: $_ is in some chan; removing from netsplit list.");
 408             delete $netsplit{$_};
 409         }
 410         next unless (time() - $netsplit{$_} > 60*10);
 411
 412         &DEBUG("netsplitC: $_ didn't come back from netsplit; removing from netsplit list.");
 413         delete $netsplit{$_};
 414     }
 415
 416     if ($count and !scalar keys %netsplit) {
 417         &DEBUG("ok, netsplit is hopefully gone. reinstating chanlimit check.");
 418         &chanlimitCheck();
 419     }
 420 }
 421
 422 sub floodLoop {
 423     my $delete   = 0;
 424     my $who;
 425
 426     if (@_) {
 427         &ScheduleThis(60, "floodLoop"); # minutes.
 428         return if ($_[0] eq "2");
 429     } else {
 430         delete $sched{"floodLoop"}{RUNNING};
 431     }
 432
 433     my $time            = time();
 434     my $interval        = &getChanConfDefault("floodCycle",60);
 435
 436     foreach $who (keys %flood) {
 437         foreach (keys %{$flood{$who}}) {
 438             if (!exists $flood{$who}{$_}) {
 439                 &WARN("flood{$who}{$_} undefined?");
 440                 next;
 441             }
 442
 443             if ($time - $flood{$who}{$_} > $interval) {
 444                 delete $flood{$who}{$_};
 445                 $delete++;
 446             }
 447         }
 448     }
 449     &VERB("floodLoop: deleted $delete items.",2);
 450 }
 451
 452 sub seenFlush {
 453     if (@_) {
 454         my $interval = &getChanConfDefault("seenFlushInterval", 60);
 455         &ScheduleThis($interval, "seenFlush");
 456         return if ($_[0] eq "2");
 457     } else {
 458         delete $sched{"seenFlush"}{RUNNING};
 459     }
 460
 461     my %stats;
 462     my $nick;
 463     my $flushed         = 0;
 464     $stats{'count_old'} = &countKeys("seen") || 0;
 465     $stats{'new'}       = 0;
 466     $stats{'old'}       = 0;
 467
 468     if ($param{'DBType'} =~ /^mysql|pg|postgres/i) {
 469         foreach $nick (keys %seencache) {
 470             if (0) {
 471             my $retval = &dbReplace("seen", $nick, (
 472                         "nick" => $seencache{$nick}{'nick'},
 473                         "time" => $seencache{$nick}{'time'},
 474                         "host" => $seencache{$nick}{'host'},
 475                         "channel" => $seencache{$nick}{'chan'},
 476                         "message" => $seencache{$nick}{'msg'},
 477             ) );
 478             &DEBUG("retval => $retval.");
 479             delete $seencache{$nick};
 480             $flushed++;
 481
 482             next;
 483             }
 484             ### OLD CODE...
 485
 486             my $exists = &dbGet("seen","nick", $nick, "nick");
 487
 488             if (defined $exists and $exists) {
 489                 &dbUpdate("seen", "nick", $nick, (
 490                         "time" => $seencache{$nick}{'time'},
 491                         "host" => $seencache{$nick}{'host'},
 492                         "channel" => $seencache{$nick}{'chan'},
 493                         "message" => $seencache{$nick}{'msg'},
 494                 ) );
 495                 $stats{'old'}++;
 496             } else {
 497                 my $retval = &dbInsert("seen", $nick, (
 498                         "nick" => $seencache{$nick}{'nick'},
 499                         "time" => $seencache{$nick}{'time'},
 500                         "host" => $seencache{$nick}{'host'},
 501                         "channel" => $seencache{$nick}{'chan'},
 502                         "message" => $seencache{$nick}{'msg'},
 503                 ) );
 504                 $stats{'new'}++;
 505
 506                 ### TODO: put bad nick into a list and don't do it again!
 507                 &FIXME("Should never happen! (nick => $nick)") if !$retval;
 508             }
 509
 510             delete $seencache{$nick};
 511             $flushed++;
 512         }
 513
 514     } elsif ($param{'DBType'} =~ /^dbm/i) {
 515
 516         foreach $nick (keys %seencache) {
 517             my $retval = &dbInsert("seen", $nick, (
 518                 "nick" => $seencache{$nick}{'nick'},
 519                 "time" => $seencache{$nick}{'time'},
 520                 "host" => $seencache{$nick}{'host'},
 521                 "channel" => $seencache{$nick}{'chan'},
 522                 "message" => $seencache{$nick}{'msg'},
 523             ) );
 524
 525             ### TODO: put bad nick into a list and don't do it again!
 526             &FIXME("Should never happen! (nick => $nick)") if !$retval;
 527
 528             delete $seencache{$nick};
 529             $flushed++;
 530         }
 531     } else {
 532         &DEBUG("seenFlush: NO VALID FACTOID SUPPORT?");
 533     }
 534
 535     &status("Flushed $flushed seen entries.")           if ($flushed);
 536     &VERB(sprintf("  new seen: %03.01f%% (%d/%d)",
 537         $stats{'new'}*100/($stats{'count_old'} || 1),
 538         $stats{'new'}, $stats{'count_old'} ), 2)        if ($stats{'new'});
 539     &VERB(sprintf("  now seen: %3.1f%% (%d/%d)",
 540         $stats{'old'}*100/&countKeys("seen"),
 541         $stats{'old'}, &countKeys("seen") ), 2)         if ($stats{'old'});
 542
 543     &WARN("scalar keys seenflush != 0!")        if (scalar keys %seenflush);
 544 }
 545
 546 sub leakCheck {
 547     my ($blah1,$blah2);
 548     my $count = 0;
 549
 550     if (@_) {
 551         &ScheduleThis(240, "leakCheck");
 552         return if ($_[0] eq "2");
 553     } else {
 554         delete $sched{"leakCheck"}{RUNNING};
 555     }
 556
 557     # flood.
 558     foreach $blah1 (keys %flood) {
 559         foreach $blah2 (keys %{$flood{$blah1}}) {
 560             $count += scalar(keys %{$flood{$blah1}{$blah2}});
 561         }
 562     }
 563     &VERB("\%flood has $count total keys.",2);
 564
 565     my $chan;
 566     foreach $chan (grep /[A-Z]/, keys %channels) {
 567         &DEBUG("leak: chan => '$chan'.");
 568         my ($i,$j);
 569         foreach $i (keys %{$channels{$chan}}) {
 570             foreach (keys %{$channels{$chan}{$i}}) {
 571                 &DEBUG("leak:   \$channels{$chan}{$i}{$_} ...");
 572             }
 573         }
 574     }
 575
 576     my $delete  = 0;
 577     foreach (keys %nuh) {
 578         next if (&IsNickInAnyChan($_));
 579         next if (exists $dcc{CHAT}{$_});
 580
 581         delete $nuh{$_};
 582         $delete++;
 583     }
 584
 585     &status("leakC: $delete nuh{} items deleted; now have ".
 586                                 scalar(keys %nuh) ) if ($delete);
 587 }
 588
 589 sub ignoreCheck {
 590     if (@_) {
 591         &ScheduleThis(60, "ignoreCheck");
 592         return if ($_[0] eq "2");       # defer.
 593     } else {
 594         delete $sched{"ignoreCheck"}{RUNNING};
 595     }
 596
 597     my $time    = time();
 598     my $count   = 0;
 599
 600     foreach (keys %ignore) {
 601         my $chan = $_;
 602
 603         foreach (keys %{ $ignore{$chan} }) {
 604             my @array = @{ $ignore{$chan}{$_} };
 605
 606             next unless ($array[0] and $time > $array[0]);
 607
 608             delete $ignore{$chan}{$_};
 609             &status("ignore: $_/$chan has expired.");
 610             $count++;
 611         }
 612     }
 613     &VERB("ignore: $count items deleted.",2);
 614 }
 615
 616 sub ircCheck {
 617
 618     if (@_) {
 619         &ScheduleThis(60, "ircCheck");
 620         return if ($_[0] eq "2");       # defer.
 621     } else {
 622         delete $sched{"ircCheck"}{RUNNING};
 623     }
 624
 625     my @array = grep !/^_default$/, keys %chanconf;
 626     my $iconf = scalar(@array);
 627     my $inow  = scalar(keys %channels);
 628     if ($iconf > 2 and $inow * 2 <= $iconf) {
 629         &FIXME("ircCheck: current channels * 2 <= config channels. FIXME.");
 630     }
 631
 632     # chanserv ops.
 633     foreach ( &ChanConfList("chanServ_ops") ) {
 634         next if (exists $channels{$chan}{'o'}{$ident});
 635
 636         &status("ChanServ ==> Requesting ops for $chan.");
 637         &rawout("PRIVMSG ChanServ :OP $chan $ident");
 638     }
 639
 640     if (!$conn->connected or time - $msgtime > 3600) {
 641         # todo: shouldn't we use cache{connect} somewhere?
 642         if (exists $cache{connect}) {
 643             &WARN("ircCheck: no msg for 3600 and disco'd! reconnecting!");
 644             $msgtime = time();  # just in case.
 645             &ircloop();
 646             delete $cache{connect};
 647         } else {
 648             &status("IRCTEST: possible lost in space; checking. ".
 649                 scalar(localtime) );
 650             &msg($ident, "TEST");
 651             $cache{connect} = time();
 652         }
 653     }
 654
 655     if ($ident !~ /^\Q$param{ircNick}\E$/) {
 656         &WARN("ircCheck: ident($ident) != param{ircNick}($param{IrcNick}).");
 657         if (! &IsNickInAnyChan( $param{ircNick} ) ) {
 658             &DEBUG("$param{ircNick} not in use... changing!");
 659             &nick( $param{ircNick} );
 660         } else {
 661             &WARN("$param{ircNick} is still in use...");
 662         }
 663     }
 664
 665     &joinNextChan();
 666         # if scalar @joinnext => join more channels
 667         # else check for chanserv.
 668
 669     if (grep /^\s*$/, keys %channels) {
 670         &WARN("we have a NULL chan in hash channels? removing!");
 671         delete $channels{''};
 672
 673         &DEBUG("channels now:");
 674         foreach (keys %channels) {
 675             &status("  $_");
 676         }
 677
 678         &DEBUG("channels END");
 679     }
 680
 681     ### USER FILE.
 682     if ($utime_userfile > $wtime_userfile and time() - $wtime_userfile > 3600) {
 683         &writeUserFile();
 684         $wtime_userfile = time();
 685     }
 686     ### CHAN FILE.
 687     if ($utime_chanfile > $wtime_chanfile and time() - $wtime_chanfile > 3600) {
 688         &writeChanFile();
 689         $wtime_chanfile = time();
 690     }
 691 }
 692
 693 sub miscCheck {
 694     if (@_) {
 695         &ScheduleThis(240, "miscCheck");
 696         return if ($_[0] eq "2");       # defer.
 697     } else {
 698         delete $sched{"miscCheck"}{RUNNING};
 699     }
 700
 701     # SHM check.
 702     my @ipcs;
 703     if ( -x "/usr/bin/ipcs") {
 704         @ipcs = `/usr/bin/ipcs`;
 705     } else {
 706         &WARN("ircCheck: no 'ipcs' binary.");
 707         return;
 708     }
 709
 710     # shmid stale remove.
 711     foreach (@ipcs) {
 712         chop;
 713
 714         # key, shmid, owner, perms, bytes, nattch
 715         next unless (/^(0x\d+) (\d+)\s+(\S+)\s+(\d+)\s+(\d+)\s+/);
 716
 717         my ($shmid, $size) = ($2,$5);
 718         next unless ($shmid != $shm and $size == 2000);
 719         my $z   = &shmRead($shmid);
 720         if ($z =~ /^(\d+): /) {
 721             my $time    = $1;
 722             next if (time() - $time < 60*60);
 723
 724         } else {
 725 #           &DEBUG("shm: $shmid is not ours or old blootbot => ($z)");
 726 #           next;
 727         }
 728
 729         &status("SHM: nuking shmid $shmid");
 730         CORE::system("/usr/bin/ipcrm shm $shmid >/dev/null");
 731     }
 732
 733     # debian check.
 734     opendir(DEBIAN, "$bot_base_dir/debian");
 735     foreach ( grep /gz$/, readdir(DEBIAN) ) {
 736         my $exit = CORE::system("gzip -t $bot_base_dir/debian/$_");
 737         next unless ($exit);
 738
 739         &status("debian: unlinking file => $_");
 740         unlink "$bot_base_dir/debian/$_";
 741     }
 742     closedir DEBIAN;
 743
 744     # make backup of important files.
 745     &mkBackup( $bot_misc_dir."/blootbot.chan", 60*60*24*1);
 746     &mkBackup( $bot_misc_dir."/blootbot.users", 60*60*24*1);
 747     &mkBackup( $bot_base_dir."/blootbot-news.txt", 60*60*24*1);
 748
 749     # flush cache{lobotomy}
 750     foreach (keys %{ $cache{lobotomy} }) {
 751         next unless (time() - $cache{lobotomy}{$_} > 60*60);
 752         delete $cache{lobotomy}{$_};
 753     }
 754
 755     ### check modules if they've been modified. might be evil.
 756     &reloadAllModules();
 757 }
 758
 759 sub shmFlush {
 760     return if ($$ != $::bot_pid); # fork protection.
 761
 762     if (@_) {
 763         &ScheduleThis(5, "shmFlush");
 764         return if ($_[0] eq "2");
 765     } else {
 766         delete $sched{"shmFlush"}{RUNNING};
 767     }
 768
 769     my $time;
 770     my $shmmsg = &shmRead($shm);
 771     $shmmsg =~ s/\0//g;         # remove padded \0's.
 772     if ($shmmsg =~ s/^(\d+): //) {
 773         $time   = $1;
 774     }
 775
 776     foreach (split '\|\|', $shmmsg) {
 777         next if (/^$/);
 778         &VERB("shm: Processing '$_'.",2);
 779
 780         if (/^DCC SEND (\S+) (\S+)$/) {
 781             my ($nick,$file) = ($1,$2);
 782             if (exists $dcc{'SEND'}{$who}) {
 783                 &msg($nick, "DCC already active.");
 784             } else {
 785                 &DEBUG("shm: dcc sending $2 to $1.");
 786                 $conn->new_send($1,$2);
 787                 $dcc{'SEND'}{$who} = time();
 788             }
 789         } elsif (/^SET FORKPID (\S+) (\S+)/) {
 790             $forked{$1}{PID} = $2;
 791         } elsif (/^DELETE FORK (\S+)$/) {
 792             delete $forked{$1};
 793         } elsif (/^EVAL (.*)$/) {
 794             &DEBUG("evaling '$1'.");
 795             eval $1;
 796         } else {
 797             &DEBUG("shm: unknown msg. ($_)");
 798         }
 799     }
 800
 801     &shmWrite($shm,"") if ($shmmsg ne "");
 802 }
 803
 804 ### this is semi-scheduled
 805 sub getNickInUse {
 806     if (@_) {
 807         &ScheduleThis(30, "getNickInUse");
 808         return if ($_[0] eq "2");       # defer.
 809     } else {
 810         delete $sched{"getNickInUse"}{RUNNING};
 811     }
 812
 813     if ($ident eq $param{'ircNick'}) {
 814         &status("okay, got my nick back.");
 815         return;
 816     }
 817
 818     &status("Trying to get my nick back.");
 819     &nick( $param{'ircNick'} );
 820 }
 821
 822 sub uptimeLoop {
 823     return unless &IsChanConf("uptime");
 824
 825     if (@_) {
 826         &ScheduleThis(60, "uptimeLoop");
 827         return if ($_[0] eq "2");       # defer.
 828     } else {
 829         delete $sched{"uptimeLoop"}{RUNNING};
 830     }
 831
 832     &uptimeWriteFile();
 833 }
 834
 835 sub slashdotLoop {
 836
 837     if (@_) {
 838         &ScheduleThis(60, "slashdotLoop");
 839         return if ($_[0] eq "2");
 840     } else {
 841         delete $sched{"slashdotLoop"}{RUNNING};
 842     }
 843
 844     my @chans = &ChanConfList("slashdotAnnounce");
 845     return unless (scalar @chans);
 846
 847     &Forker("slashdot", sub {
 848         my $line = &Slashdot::slashdotAnnounce();
 849         return unless (defined $line);
 850
 851         foreach (@chans) {
 852             next unless (&::validChan($_));
 853
 854             &::status("sending slashdot update to $_.");
 855             &notice($_, "Slashdot: $line");
 856         }
 857     } );
 858 }
 859
 860 sub freshmeatLoop {
 861     if (@_) {
 862         &ScheduleThis(60, "freshmeatLoop");
 863         return if ($_[0] eq "2");
 864     } else {
 865         delete $sched{"freshmeatLoop"}{RUNNING};
 866     }
 867
 868     my @chans = &ChanConfList("freshmeatAnnounce");
 869     return unless (scalar @chans);
 870
 871     &Forker("freshmeat", sub {
 872         my $data = &Freshmeat::freshmeatAnnounce();
 873
 874         foreach (@chans) {
 875             next unless (&::validChan($_));
 876
 877             &::status("sending freshmeat update to $_.");
 878             &msg($_, $data);
 879         }
 880     } );
 881 }
 882
 883 sub kernelLoop {
 884     if (@_) {
 885         &ScheduleThis(240, "kernelLoop");
 886         return if ($_[0] eq "2");
 887     } else {
 888         delete $sched{"kernelLoop"}{RUNNING};
 889     }
 890
 891     my @chans = &ChanConfList("kernelAnnounce");
 892     return unless (scalar @chans);
 893
 894     &Forker("kernel", sub {
 895         my @data = &Kernel::kernelAnnounce();
 896
 897         foreach (@chans) {
 898             next unless (&::validChan($_));
 899
 900             &::status("sending kernel update to $_.");
 901             my $c = $_;
 902             foreach (@data) {
 903                 &notice($c, "Kernel: $_");
 904             }
 905         }
 906     } );
 907 }
 908
 909 sub wingateCheck {
 910     return unless &IsChanConf("wingate");
 911
 912     ### FILE CACHE OF OFFENDING WINGATES.
 913     foreach (grep /^$host$/, @wingateBad) {
 914         &status("Wingate: RUNNING ON $host BY $who");
 915         &ban("*!*\@$host", "") if &IsChanConf("wingateBan");
 916
 917         my $reason      = &getChanConf("wingateKick");
 918
 919         next unless ($reason);
 920         &kick($who, "", $reason)
 921     }
 922
 923     ### RUN CACHE OF TRIED WINGATES.
 924     if (grep /^$host$/, @wingateCache) {
 925         push(@wingateNow, $host);       # per run.
 926         push(@wingateCache, $host);     # cache per run.
 927     } else {
 928         &DEBUG("Already scanned $host. good.");
 929     }
 930
 931     my $interval = &getChanConfDefault("wingateInterval", 60); # seconds.
 932     return if (defined $forked{'wingate'});
 933     return if (time() - $wingaterun <= $interval);
 934     return unless (scalar(keys %wingateToDo));
 935
 936     $wingaterun = time();
 937
 938     &Forker("wingate", sub { &Wingate::Wingates(keys %wingateToDo); } );
 939     undef @wingateNow;
 940 }
 941
 942 ### TODO.
 943 sub wingateWriteFile {
 944     if (@_) {
 945         &ScheduleThis(60, "wingateWriteFile");
 946         return if ($_[0] eq "2");       # defer.
 947     } else {
 948         delete $sched{"wingateWriteFile"}{RUNNING};
 949     }
 950
 951     return unless (scalar @wingateCache);
 952
 953     my $file = "$bot_base_dir/$param{'ircUser'}.wingate";
 954     if ($bot_pid != $$) {
 955         &DEBUG("wingateWriteFile: Reorganising!");
 956
 957         open(IN, $file);
 958         while (<IN>) {
 959             chop;
 960             push(@wingateNow, $_);
 961         }
 962         close IN;
 963
 964         # very lame hack.
 965         my %hash = map { $_ => 1 } @wingateNow;
 966         @wingateNow = sort keys %hash;
 967     }
 968
 969     &DEBUG("wingateWF: writing...");
 970     open(OUT, ">$file");
 971     foreach (@wingateNow) {
 972         print OUT "$_\n";
 973     }
 974     close OUT;
 975
 976 }
 977
 978 sub factoidCheck {
 979     if (@_) {
 980         &ScheduleThis(1440, "factoidCheck");
 981         return if ($_[0] eq "2");       # defer.
 982     } else {
 983         delete $sched{"factoidCheck"}{RUNNING};
 984     }
 985
 986     my @list    = &searchTable("factoids", "factoid_key", "factoid_key", " #DEL#");
 987     my $stale   = &getChanConfDefault("factoidDeleteDelay", 30) *60*60*24;
 988     my $time    = time();
 989
 990     foreach (@list) {
 991         my $age = &getFactInfo($_, "modified_time");
 992         if (!defined $age or $age !~ /^\d+$/) {
 993             &WARN("age == NULL or not numeric.");
 994             next;
 995         }
 996
 997         next unless ($time - $age > $stale);
 998
 999         my $fix = $_;
1000         $fix =~ s/ #DEL#$//g;
1001         &DEBUG("safedel: Removing $fix ($_) for good.");
1002
1003         &delFactoid($_);
1004     }
1005
1006 }
1007
1008 sub dccStatus {
1009     return unless (scalar keys %{ $dcc{CHAT} });
1010
1011     if (@_) {
1012         &ScheduleThis(10, "dccStatus");
1013         return if ($_[0] eq "2");       # defer.
1014     } else {
1015         delete $sched{"dccStatus"}{RUNNING};
1016     }
1017
1018     my $time = strftime("%H:%M", localtime(time()) );
1019
1020     my $c;
1021     foreach (keys %channels) {
1022         my $c           = $_;
1023         my $users       = keys %{ $channels{$c}{''} };
1024         my $chops       = keys %{ $channels{$c}{o}  };
1025         my $bans        = keys %{ $channels{$c}{b}  };
1026
1027         my $txt = "[$time] $c: $users members ($chops chops), $bans bans";
1028         foreach (keys %{ $dcc{'CHAT'} }) {
1029             next unless (exists $channels{$c}{''}{lc $_});
1030             $conn->privmsg($dcc{'CHAT'}{$_}, $txt);
1031         }
1032     }
1033 }
1034
1035 sub scheduleList {
1036     ###
1037     # custom:
1038     #   a - time == now.
1039     #   b - weird time.
1040     ###
1041
1042     &DEBUG("sched:");
1043     foreach (keys %{ $irc->{_queue} }) {
1044         my $q = $_;
1045
1046         my $sched;
1047         foreach (keys %sched) {
1048             next unless ($q eq $sched{$_});
1049             $sched = $_;
1050             last;
1051         }
1052
1053         my $time = $irc->{_queue}->{$q}->[0] - time();
1054
1055         if (defined $sched) {
1056             &DEBUG("   $sched($q): ".&Time2String($time) );
1057         } else {
1058             &DEBUG("   NULL($q): ".&Time2String($time) );
1059         }
1060     }
1061
1062     &DEBUG("end of sList.");
1063 }
1064
1065 sub getChanConfDefault {
1066     my($what, $default, $chan) = @_;
1067
1068     if (exists $param{$what}) {
1069         if (!exists $cache{config}{$what}) {
1070             &status("conf: backward-compat: found param{$what} ($param{$what}) instead.");
1071             $cache{config}{$what} = 1;
1072         }
1073
1074         return $param{$what};
1075     }
1076
1077     my $val = &getChanConf($what, $chan);
1078     if (defined $val) {
1079         return $val;
1080     }
1081
1082     $param{$what}       = $default;
1083     &status("conf: auto-setting param{$what} = $default");
1084     $cache{config}{$what} = 1;
1085
1086     return $default;
1087 }
1088
1089 sub mkBackup {
1090     my($file, $time) = @_;
1091     my $backup  = 0;
1092
1093     if ( -e "$file~" ) {
1094         $backup++ if ( -s $file > -s "$file~");
1095         $backup++ if ((stat $file)[9] - (stat "$file~")[9] > $time);
1096     } else {
1097         $backup++;
1098     }
1099     return unless ($backup);
1100
1101     ### TODO: do internal copying.
1102     &status("Backup: $file to $file~");
1103     CORE::system("/bin/cp $file $file~");
1104     CORE::system("/bin/touch $file~");  # needed!
1105 }
1106
1107 1;