fix nasty timer bug

diff --git a/Changes b/Changes
index c8428e0be3e251fdf5bd4b4ff3d32f2613e6e3bd..4cb272e4d307bc379fc0a42e46a9a93c021f5fe1 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,6 +1,7 @@
 10Apr01=======================================================================
 1. altered PC21 logic somewhat to eliminate dup PC21s
 2. disconnect should remove dangling local users in the routing table.
+3. fixed nasty recursive timer bug
 09Apr01=======================================================================
 1. changed lockfile name to cluster.lck (from .lock) for MSWin's benefit
 08Apr01=======================================================================

diff --git a/cmd/disconnect.pl b/cmd/disconnect.pl
index 00a462a70e4955b44f252b77621dcb01956f9c50..9acf0ce336fa5f37d5621b80139803097187c67b 100644 (file)
--- a/cmd/disconnect.pl
+++ b/cmd/disconnect.pl
@@ -26,9 +26,9 @@ foreach $call (@calls) {
        } elsif (my $conn = Msg->conns($call)) {
                $conn->disconnect;
                push @out, $self->msg('disc3', $call);
-       } elsif (my $ref = DXCLuster->get_exact($call)) {
-               my $dxchan = $ref->dxchan;
-               if ($dxchan && $dxchan->call eq $main::mycall) {
+       } elsif (my $ref = DXCluster->get_exact($call)) {
+               my $dxchancall = $ref->dxchancall;
+               if ($dxchancall eq $main::mycall || !DXChannel->get($dxchancall)) {
                        $ref->del;
                        push @out, $self->msg('disc4', $call);
                }

diff --git a/perl/ExtMsg.pm b/perl/ExtMsg.pm
index 4475f6a10cbf6623f5c8f12163acb6cf14f97198..cc938bd822223706de2e50369d5cd29fe1b0590c 100644 (file)
--- a/perl/ExtMsg.pm
+++ b/perl/ExtMsg.pm
@@ -335,8 +335,6 @@ sub _timedout
 {
        my $conn = shift;
        dbg('connect', "timed out after $conn->{timeval} seconds");
-       $conn->{timeout}->del;
-       delete $conn->{timeout};
        $conn->disconnect;
 }
 

diff --git a/perl/Timer.pm b/perl/Timer.pm
index 0c44278e05067723a8d0a5e25df430af2ada801c..281421f08d72394b13c54912d97fbb476d3ae0ba 100644 (file)
--- a/perl/Timer.pm
+++ b/perl/Timer.pm
@@ -41,17 +41,18 @@ sub handler
        my $now = time;
        
        # handle things on the timer chain
-       for (@timerchain) {
-               if ($now >= $_->{t}) {
-                       &{$_->{proc}}();
-                       $_->{t} = $now + $_->{interval} if exists $_->{interval};
+       my $t;
+       foreach $t (@timerchain) {
+               if ($now >= $t->{t}) {
+                       &{$t->{proc}}();
+                       $t->{t} = $now + $t->{interval} if exists $t->{interval};
                }
        }
 }
 
 sub DESTROY
 {
-       dbg('connll', "Timer destroyed ($notimers)");
-       $notimers--;
+       dbg('connll', "timer destroyed ($Timer::notimers)");
+       $Timer::notimers--;
 }
 1;

diff --git a/perl/cluster.pl b/perl/cluster.pl
index 8a02bfd376adf9110afd20a77363c0f740af1083..6ac7a3fb907265f6bb92dbedd29d599d9d2c1662 100755 (executable)
--- a/perl/cluster.pl
+++ b/perl/cluster.pl
@@ -100,7 +100,7 @@ sub already_conn
        
        dbg('chan', "-> D $call $mess\n"); 
        $conn->send_now("D$call|$mess");
-       Msg->sleep(2);
+       sleep(2);
        $conn->disconnect;
 }