]> git.donarmstrong.com Git - infobot.git/blobdiff - src/IRC/Schedulers.pl
converted %{$blah{$blah}} to %{ $blah{$blah} }
[infobot.git] / src / IRC / Schedulers.pl
index 765f6a8c857b7eea4cd4d34910113f96f3c27cce..7519ef0be91d4edf2ba30877a44a8ada2740285b 100644 (file)
@@ -16,6 +16,7 @@ sub setupSchedulers {
     # ONCE OFF.
 
     # REPETITIVE.
+    # 1 for run straight away, 2 for on next-run.
     &uptimeLoop(1);
     &randomQuote(2);
     &randomFactoid(2);
@@ -28,14 +29,16 @@ sub setupSchedulers {
     &leakCheck(2);     # mandatory
     &ignoreCheck(1);   # mandatory
     &seenFlushOld(2);
-    &ircCheck(1);      # mandatory
-    &miscCheck(2);     # mandatory
+    &ircCheck(2);      # mandatory
+    &miscCheck(1);     # mandatory
+    &miscCheck2(2);    # mandatory
     &shmFlush(1);      # mandatory
     &slashdotLoop(2);
     &freshmeatLoop(2);
     &kernelLoop(2);
     &wingateWriteFile(2);
     &factoidCheck(2);
+    &newsFlush(1);
 
 #    my $count = map { exists $sched{$_}{TIME} } keys %sched;
     my $count  = 0;
@@ -118,7 +121,8 @@ sub randomFactoid {
     while (1) {
        ($key,$val) = &randKey("factoids","factoid_key,factoid_value");
 ###    $val =~ tr/^[A-Z]/[a-z]/;       # blah is Good => blah is good.
-       last if ($val !~ /^</);
+       last if (defined $val and $val !~ /^</);
+
        $error++;
        if ($error == 5) {
            &ERROR("rF: tried 5 times but failed.");
@@ -191,7 +195,7 @@ sub logLoop {
        }
 
        &closeLog();
-       system("/bin/mv '$param{'logfile'}' '$file{log}'");
+       CORE::system("/bin/mv '$param{'logfile'}' '$file{log}'");
        &compress($file{log});
        &openLog();
        &status("cycling log file.");
@@ -281,6 +285,63 @@ sub seenFlushOld {
 
 }
 
+sub newsFlush {
+    if (@_) {
+       &ScheduleThis(1440, "newsFlush");
+       return if ($_[0] eq "2");       # defer.
+    } else {
+       delete $sched{"newsFlush"}{RUNNING};
+    }
+
+    return unless (&IsChanConf("news") > 0);
+
+    my $delete = 0;
+    my $oldest = time();
+    foreach $chan (keys %::news) {
+       foreach $item (keys %{ $::news{$chan} }) {
+           my $t = $::news{$chan}{$item}{Expire};
+
+           my $tadd    = $::news{$chan}{$item}{Time};
+           $oldest     = $tadd if ($oldest > $tadd);
+
+           next if ($t == 0 or $t == -1);
+           if ($t < 1000) {
+               &status("newsFlush: Fixed Expire time for $chan/$item, should not happen anyway.");
+               $::news{$chan}{$item}{Expire} = time() + $t*60*60*24;
+               next;
+           }
+
+           next unless (time() > $t);
+           # todo: show how old it was.
+           delete $::news{$chan}{$item};
+           &VERB("NEWS: deleted '$item'", 2);
+           $delete++;
+       }
+    }
+
+    # todo: flush users aswell.
+    my $duser  = 0;
+    foreach $chan (keys %::newsuser) {
+       foreach (keys %{ $::newsuser{$chan} }) {
+           my $t = $::newsuser{$chan}{$_};
+           if (!defined $t or ($t > 2 and $t < 1000)) {
+               &DEBUG("something wrong with newsuser{$chan}{$_} => $t");
+               next;
+           }
+
+           next unless ($oldest > $t);
+
+           delete $::newsuser{$chan}{$_};
+           $duser++;
+       }
+    }
+
+#    &VERB("NEWS deleted $delete seen entries.",2);
+    &status("NEWS deleted: $delete news entries; $duser user cache.");
+
+    &News::writeNews();
+}
+
 sub chanlimitCheck {
     my $interval = &getChanConfDefault("chanlimitcheckInterval", 10);
 
@@ -291,26 +352,42 @@ sub chanlimitCheck {
        delete $sched{"chanlimitCheck"}{RUNNING};
     }
 
-    foreach ( &ChanConfList("chanlimitcheck") ) {
-       next unless (&validChan($_));
+    foreach $chan ( &ChanConfList("chanlimitcheck") ) {
+       next unless (&validChan($chan));
 
-       my $limitplus   = &getChanConfDefault("chanlimitcheckPlus", 5, $_);
-       my $newlimit    = scalar(keys %{$channels{$_}{''}}) + $limitplus;
-       my $limit       = $channels{$_}{'l'};
+       my $limitplus   = &getChanConfDefault("chanlimitcheckPlus", 5, $chan);
+       my $newlimit    = scalar(keys %{ $channels{$chan}{''} }) + $limitplus;
+       my $limit       = $channels{$chan}{'l'};
 
-       if (scalar keys %{$channels{$_}{''}} > $limit) {
+       if (defined $limit and scalar keys %{ $channels{$chan}{''} } > $limit) {
            &FIXME("LIMIT: set too low!!! FIXME");
            ### run NAMES again and flush it.
        }
 
        next unless (!defined $limit or $limit != $newlimit);
 
-       if (!exists $channels{$_}{'o'}{$ident}) {
-           &ERROR("chanlimitcheck: dont have ops on $_.");
+       if (!exists $channels{$chan}{'o'}{$ident}) {
+           &status("ChanLimit: dont have ops on $chan.") unless (exists $cache{warn}{chanlimit}{$chan});
+           $cache{warn}{chanlimit}{$chan} = 1;
+           &chanServCheck($chan);
            next;
        }
+       delete $cache{warn}{chanlimit}{$chan};
 
-       &rawout("MODE $_ +l $newlimit");
+       if (!defined $limit) {
+           &status("ChanLimit: setting for first time or from netsplit, for $chan");
+       }
+
+       if (exists $cache{chanlimitChange}{$chan}) {
+           my $delta = time() - $cache{chanlimitChange}{$chan};
+           if ($delta < $interval*60) {
+               &DEBUG("not going to change chanlimit! ($delta<$interval*60)");
+               return;
+           }
+       }
+
+       &rawout("MODE $chan +l $newlimit");
+       $cache{chanlimitChange}{$chan} = time();
     }
 }
 
@@ -325,7 +402,7 @@ sub netsplitCheck {
     }
 
     foreach $s1 (keys %netsplitservers) {
-       foreach $s2 (keys %{$netsplitservers{$s1}}) {
+       foreach $s2 (keys %{ $netsplitservers{$s1} }) {
            if (time() - $netsplitservers{$s1}{$s2} > 3600) {
                &status("netsplit between $s1 and $s2 appears to be stale.");
                delete $netsplitservers{$s1}{$s2};
@@ -334,17 +411,23 @@ sub netsplitCheck {
     }
 
     # %netsplit hash checker.
+    my $count  = scalar keys %netsplit;
     foreach (keys %netsplit) {
        if (&IsNickInAnyChan($_)) {
            &DEBUG("netsplitC: $_ is in some chan; removing from netsplit list.");
            delete $netsplit{$_};
+           next;
        }
-       next unless (time() - $netsplit{$_} > 60*60*2); # 2 hours.
-       next if (&IsNickInAnyChan($_));
+       next unless (time() - $netsplit{$_} > 60*10);
 
-       &DEBUG("netsplitC: $_ didn't come back from netsplit in 2 hours; removing from netsplit list.");
+       &DEBUG("netsplitC: $_ didn't come back from netsplit; removing from netsplit list.");
        delete $netsplit{$_};
     }
+
+    if ($count and !scalar keys %netsplit) {
+       &DEBUG("ok, netsplit is hopefully gone. reinstating chanlimit check.");
+       &chanlimitCheck();
+    }
 }
 
 sub floodLoop {
@@ -362,7 +445,7 @@ sub floodLoop {
     my $interval       = &getChanConfDefault("floodCycle",60);
 
     foreach $who (keys %flood) {
-       foreach (keys %{$flood{$who}}) {
+       foreach (keys %{ $flood{$who} }) {
            if (!exists $flood{$who}{$_}) {
                &WARN("flood{$who}{$_} undefined?");
                next;
@@ -395,6 +478,23 @@ sub seenFlush {
 
     if ($param{'DBType'} =~ /^mysql|pg|postgres/i) {
        foreach $nick (keys %seencache) {
+           if (0) {
+           #BROKEN#
+           my $retval = &dbReplace("seen", "nick", $nick, (
+                       "nick" => $seencache{$nick}{'nick'},
+                       "time" => $seencache{$nick}{'time'},
+                       "host" => $seencache{$nick}{'host'},
+                       "channel" => $seencache{$nick}{'chan'},
+                       "message" => $seencache{$nick}{'msg'},
+           ) );
+           &DEBUG("retval => $retval.");
+           delete $seencache{$nick};
+           $flushed++;
+
+           next;
+           }
+           ### OLD CODE...
+
            my $exists = &dbGet("seen","nick", $nick, "nick");
 
            if (defined $exists and $exists) {
@@ -446,7 +546,7 @@ sub seenFlush {
 
     &status("Flushed $flushed seen entries.")          if ($flushed);
     &VERB(sprintf("  new seen: %03.01f%% (%d/%d)",
-       $stats{'new'}*100/$stats{'count_old'},
+       $stats{'new'}*100/($stats{'count_old'} || 1),
        $stats{'new'}, $stats{'count_old'} ), 2)        if ($stats{'new'});
     &VERB(sprintf("  now seen: %3.1f%% (%d/%d)",
        $stats{'old'}*100/&countKeys("seen"),
@@ -468,18 +568,31 @@ sub leakCheck {
 
     # flood.
     foreach $blah1 (keys %flood) {
-       foreach $blah2 (keys %{$flood{$blah1}}) {
-           $count += scalar(keys %{$flood{$blah1}{$blah2}});
+       foreach $blah2 (keys %{ $flood{$blah1} }) {
+           $count += scalar(keys %{ $flood{$blah1}{$blah2} });
+       }
+    }
+    &DEBUG("leak: hash flood has $count total keys.",2);
+
+    # floodjoin.
+    $count = 0;
+    foreach $blah1 (keys %floodjoin) {
+       foreach $blah2 (keys %{ $floodjoin{$blah1} }) {
+           $count += scalar(keys %{ $floodjoin{$blah1}{$blah2} });
        }
     }
-    &VERB("\%flood has $count total keys.",2);
+    &DEBUG("leak: hash flood has $count total keys.",2);
+
+    # floodwarn.
+    $count = scalar(keys %floodwarn);
+    &DEBUG("leak: hash floodwarn has $count total keys.",2);
 
     my $chan;
     foreach $chan (grep /[A-Z]/, keys %channels) {
        &DEBUG("leak: chan => '$chan'.");
        my ($i,$j);
-       foreach $i (keys %{$channels{$chan}}) {
-           foreach (keys %{$channels{$chan}{$i}}) {
+       foreach $i (keys %{ $channels{$chan} }) {
+           foreach (keys %{ $channels{$chan}{$i} }) {
                &DEBUG("leak:   \$channels{$chan}{$i}{$_} ...");
            }
        }
@@ -494,7 +607,7 @@ sub leakCheck {
        $delete++;
     }
 
-    &DEBUG("$delete nuh{} items deleted; now have ".
+    &status("leak: $delete nuh{} items deleted; now have ".
                                scalar(keys %nuh) ) if ($delete);
 }
 
@@ -526,9 +639,8 @@ sub ignoreCheck {
 }
 
 sub ircCheck {
-
     if (@_) {
-       &ScheduleThis(120, "ircCheck");
+       &ScheduleThis(60, "ircCheck");
        return if ($_[0] eq "2");       # defer.
     } else {
        delete $sched{"ircCheck"}{RUNNING};
@@ -541,22 +653,26 @@ sub ircCheck {
        &FIXME("ircCheck: current channels * 2 <= config channels. FIXME.");
     }
 
-    # chanserv ops.
-    foreach ( &ChanConfList("chanServ_ops") ) {
-       next if (exists $channels{$chan}{'o'}{$ident});
-
-       &status("ChanServ ==> Requesting ops for $chan.");
-       &rawout("PRIVMSG ChanServ :OP $chan $ident");
-    }
-
-    if (!$conn->connected and time - $msgtime > 3600) {
-       &WARN("ircCheck: no msg for 3600 and disco'd! reconnecting!");
-       $msgtime = time();      # just in case.
-       &ircloop();
+    if (!$conn->connected or time() - $msgtime > 3600) {
+       # todo: shouldn't we use cache{connect} somewhere?
+       if (exists $cache{connect}) {
+           &WARN("ircCheck: no msg for 3600 and disco'd! reconnecting!");
+           $msgtime = time();  # just in case.
+           &ircloop();
+           delete $cache{connect};
+       } else {
+           &status("IRCTEST: possible lost in space; checking. ".
+               scalar(localtime) );
+           &msg($ident, "TEST");
+           $cache{connect} = time();
+       }
     }
 
     if ($ident !~ /^\Q$param{ircNick}\E$/) {
+       # this does not work unfortunately.
        &WARN("ircCheck: ident($ident) != param{ircNick}($param{IrcNick}).");
+
+       # this check is misleading... perhaps we should do a notify.
        if (! &IsNickInAnyChan( $param{ircNick} ) ) {
            &DEBUG("$param{ircNick} not in use... changing!");
            &nick( $param{ircNick} );
@@ -565,22 +681,22 @@ sub ircCheck {
        }
     }
 
-    &joinNextChan();
-       # if scalar @joinnext => join more channels
-       # else check for chanserv.
-
     if (grep /^\s*$/, keys %channels) {
-       &WARN("we have a NULL chan in hash channels? removing!");
-       delete $channels{''};
-
-       &DEBUG("channels now:");
-       foreach (keys %channels) {
-           &status("  $_");
+       &WARN("ircCheck: we have a NULL chan in hash channels? removing!");
+       if (exists $channels{''}) {
+           &DEBUG("ircCheck: ok it existed!");
+       } else {
+           &DEBUG("ircCheck: this hsould never happen!");
        }
 
-       &DEBUG("channels END");
+       delete $channels{''};
     }
 
+    &DEBUG("ircstats...");
+    &DEBUG("  pubsleep: $pubsleep");
+    &DEBUG("  msgsleep: $msgsleep");
+    &DEBUG("  notsleep: $notsleep");
+
     ### USER FILE.
     if ($utime_userfile > $wtime_userfile and time() - $wtime_userfile > 3600) {
        &writeUserFile();
@@ -625,18 +741,43 @@ sub miscCheck {
            next if (time() - $time < 60*60);
 
        } else {
-           &DEBUG("shm: $shmid is not ours or old blootbot => ($z)");
-           next;
+#          &DEBUG("shm: $shmid is not ours or old blootbot => ($z)");
+#          next;
        }
 
        &status("SHM: nuking shmid $shmid");
-       system("/usr/bin/ipcrm shm $shmid >/dev/null");
+       CORE::system("/usr/bin/ipcrm shm $shmid >/dev/null");
     }
 
+    # make backup of important files.
+    &mkBackup( $bot_misc_dir."/blootbot.chan", 60*60*24*3);
+    &mkBackup( $bot_misc_dir."/blootbot.users", 60*60*24*3);
+    &mkBackup( $bot_base_dir."/blootbot-news.txt", 60*60*24*1);
+
+    # flush cache{lobotomy}
+    foreach (keys %{ $cache{lobotomy} }) {
+       next unless (time() - $cache{lobotomy}{$_} > 60*60);
+       delete $cache{lobotomy}{$_};
+    }
+
+    ### check modules if they've been modified. might be evil.
+    &reloadAllModules();
+}
+
+sub miscCheck2 {
+    if (@_) {
+       &ScheduleThis(240, "miscCheck2");
+       return if ($_[0] eq "2");       # defer.
+    } else {
+       delete $sched{"miscCheck2"}{RUNNING};
+    }
+
+    &DEBUG("miscCheck2: Doing debian checking...");
+
     # debian check.
     opendir(DEBIAN, "$bot_base_dir/debian");
     foreach ( grep /gz$/, readdir(DEBIAN) ) {
-       my $exit = system("gzip -t $bot_base_dir/debian/$_");
+       my $exit = CORE::system("gzip -t $bot_base_dir/debian/$_");
        next unless ($exit);
 
        &status("debian: unlinking file => $_");
@@ -644,26 +785,21 @@ sub miscCheck {
     }
     closedir DEBIAN;
 
-    # user/chan file check.
-    foreach ("chan","users") {
-       my $f           = $bot_misc_dir."/blootbot.$_";
-       my $backup      = 0;
+    # compress logs that should have been compressed.
+    # todo: use strftime?
+    my ($day,$month,$year) = (localtime(time()))[3,4,5];
+    my $date = sprintf("%04d%02d%02d",$year+1900,$month+1,$day);
 
-       if ( -e "$f~" ) {
-           $backup++ if ( -s $f > -s "$f~");
-           $backup++ if ( (stat $f)[9] - (stat "$f~")[9] > 60*60*24*7);
-       } else {
-           $backup++;
-       }
-       next unless ($backup);
+    opendir(DIR,"$bot_base_dir/log");
+    while (my $f = readdir(DIR)) {
+       next unless ( -f "$bot_base_dir/log/$f");
+       next if ($f =~ /gz|bz2/);
+       next unless ($f =~ /(\d{8})/);
+       next if ($date eq $1);
 
-       ### TODO: do internal copying.
-       &status("Backup: $f to $f~");
-       system("/bin/cp $f $f~");
+       &compress("$bot_base_dir/log/$f");
     }
-
-    ### check modules if they've been modified. might be evil.
-    &reloadAllModules();
+    closedir DIR;
 }
 
 sub shmFlush {
@@ -713,6 +849,11 @@ sub shmFlush {
 
 ### this is semi-scheduled
 sub getNickInUse {
+    if ($ident eq $param{'ircNick'}) {
+       &status("okay, got my nick back.");
+       return;
+    }
+
     if (@_) {
        &ScheduleThis(30, "getNickInUse");
        return if ($_[0] eq "2");       # defer.
@@ -720,16 +861,13 @@ sub getNickInUse {
        delete $sched{"getNickInUse"}{RUNNING};
     }
 
-    if ($ident eq $param{'ircNick'}) {
-       &status("okay, got my nick back.");
-       return;
-    }
-
     &status("Trying to get my nick back.");
     &nick( $param{'ircNick'} );
 }
 
 sub uptimeLoop {
+    return unless &IsChanConf("uptime");
+
     if (@_) {
        &ScheduleThis(60, "uptimeLoop");
        return if ($_[0] eq "2");       # defer.
@@ -975,7 +1113,7 @@ sub getChanConfDefault {
 
     if (exists $param{$what}) {
        if (!exists $cache{config}{$what}) {
-           &status("gCCD: backward-compat: found param{$what} ($param{$what}) instead.");
+           &status("conf: backward-compat: found param{$what} ($param{$what}) instead.");
            $cache{config}{$what} = 1;
        }
 
@@ -988,10 +1126,31 @@ sub getChanConfDefault {
     }
 
     $param{$what}      = $default;
-    &status("gCCD: setting default for param{$what} = $default");
+    &status("conf: auto-setting param{$what} = $default");
     $cache{config}{$what} = 1;
 
     return $default;
 }
 
+sub mkBackup {
+    my($file, $time) = @_;
+    my $backup = 0;
+
+    if (! -f $file) {
+       &WARN("mkB: file $file don't exist.");
+       return;
+    }
+
+    if ( -e "$file~" ) {
+       $backup++ if ((stat $file)[9] - (stat "$file~")[9] > $time);
+    } else {
+       $backup++;
+    }
+    return unless ($backup);
+
+    ### TODO: do internal copying.
+    &status("Backup: $file to $file~");
+    CORE::system("/bin/cp $file $file~");
+}
+
 1;