Started the new routing stuff which will run in parallel for a while.

Changed the msg timeout arrangements so that it might not get stuck so
easily.

diff --git a/Changes b/Changes
index 632b8b9cda0e72f7368e7d727d4fab3b674eaa3f..ec8c2aeb0678cb5ac5f39e21b421045e227d7a0c 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,5 +1,8 @@
 15May01=======================================================================
 1. set/lockout now prevents any outgoing connection taking place.
+2. Started the new routing stuff which will run in parallel for a while.
+3. changed the msg timeout arrangements so that it might not get stuck so
+easily.
 14May01=======================================================================
 1. fix problem with re-reading in db definitions for remote databases.
 2. try to prevent situations where two can (semi) successfully login, probably

diff --git a/cmd/stat/channel.pl b/cmd/stat/channel.pl
index 8b20e0cbd759148ee63d465dc2e7ba55dd5c9d49..d963eb45eee91b62b56404952b067530cbe30d8f 100644 (file)
--- a/cmd/stat/channel.pl
+++ b/cmd/stat/channel.pl
@@ -7,7 +7,7 @@
 use strict;
 my ($self, $line) = @_;
 my @list = split /\s+/, $line;           # generate a list of callsigns
-@list = ($self->call) if !@list || $self->priv < 9;  # my channel if no callsigns
+@list = ($self->call) if !@list || $self->priv < 1;  # my channel if no callsigns
 
 my $call;
 my @out;

diff --git a/perl/DXMsg.pm b/perl/DXMsg.pm
index cb71c97d1a66810290a76f53e1fdf55761ffd491..d5631904971148fae3c246cbff338d4033b4cb2b 100644 (file)
--- a/perl/DXMsg.pm
+++ b/perl/DXMsg.pm
@@ -129,20 +129,6 @@ sub process
 
                if ($main::systime >= $lastq + $queueinterval) {
 
-                       # wander down the work queue stopping any messages that have timed out
-                       for (keys %busy) {
-                               my $node = $_;
-                               my $ref = $busy{$_};
-                               if (exists $ref->{lastt} && $main::systime >= $ref->{lastt} + $timeout) {
-                                       dbg('msg', "Timeout, stopping msgno: $ref->{msgno} -> $node");
-                                       Log('msg', "Timeout, stopping msgno: $ref->{msgno} -> $node");
-                                       $ref->stop_msg($node);
-                                       
-                                       # delay any outgoing messages that fail
-                                       $ref->{waitt} = $main::systime + $waittime + rand(120) if $node ne $main::mycall;
-                               }
-                       }
-
                        # queue some message if the interval timer has gone off
                        queue_msg(0);
 
@@ -591,8 +577,6 @@ sub queue_msg
        dbg('msg', "queue msg ($sort)\n");
        my @nodelist = DXChannel::get_all_nodes;
        foreach $ref (@msg) {
-               # firstly, is it private and unread? if so can I find the recipient
-               # in my cluster node list offsite?
 
                # ignore 'delayed' messages until their waiting time has expired
                if (exists $ref->{waitt}) {
@@ -600,6 +584,22 @@ sub queue_msg
                        delete $ref->{waitt};
                } 
 
+               # any time outs?
+               if (exists $ref->{lastt} && $main::systime >= $ref->{lastt} + $timeout) {
+                       my $node = $ref->{tonode};
+                       dbg('msg', "Timeout, stopping msgno: $ref->{msgno} -> $node");
+                       Log('msg', "Timeout, stopping msgno: $ref->{msgno} -> $node");
+                       $ref->stop_msg($node);
+                       
+                       # delay any outgoing messages that fail
+                       $ref->{waitt} = $main::systime + $waittime + rand(120) if $node ne $main::mycall;
+                       delete $ref->{lastt};
+                       next;
+               }
+
+               # firstly, is it private and unread? if so can I find the recipient
+               # in my cluster node list offsite?
+
                # deal with routed private messages
                my $dxchan;
                if ($ref->{private}) {

diff --git a/perl/DXProt.pm b/perl/DXProt.pm
index 1ba185b183d4123f2489115c76088b71df6d3bb1..decd71f674452ea072172baab71a60b280d34f70 100644 (file)
--- a/perl/DXProt.pm
+++ b/perl/DXProt.pm
@@ -31,6 +31,7 @@ use WCY;
 use Time::HiRes qw(gettimeofday tv_interval);
 use BadWords;
 use DXHash;
+use Route::Node;
 
 use strict;
 use vars qw($me $pc11_max_age $pc23_max_age
@@ -180,6 +181,7 @@ sub init
        confess $@ if $@;
        $me->{sort} = 'S';    # S for spider
        $me->{priv} = 9;
+       $Route::Node::me->adddxchan($me);
 }
 
 #

diff --git a/perl/Route/Node.pm b/perl/Route/Node.pm
new file mode 100644 (file)
index 0000000..2fee0ac
--- /dev/null
+++ b/perl/Route/Node.pm
@@ -0,0 +1,80 @@
+#
+# Node routing routines
+#
+# Copyright (c) 2001 Dirk Koopman G1TLH
+#
+# $Id$
+# 
+
+package Route::Node;
+
+use DXDebug;
+use Route;
+
+use strict;
+
+use vars qw(%list %valid @ISA $me);
+@ISA = qw(Route);
+
+%valid = (
+                 dxchancall => '0,DXChannel Calls,parray',
+                 parent => '0,Parent Calls,parray',
+                 version => '0,Version',
+);
+
+%list = ();
+
+sub init
+{
+       $me = Route::Node->new(@_);
+}
+
+sub new
+{
+       my $pkg = shift;
+       my $call = uc shift;
+       confess "already have $call in $pkg" if $list{$call};
+       
+       my $self = $pkg->SUPER::new($call);
+       $self->{dxchancall} = [ ];
+       $self->{parent} = [ ];
+       $self->{version} = shift;
+       
+       $list{$call} = $self;
+       
+       return $self;
+}
+
+sub get
+{
+       my $call = shift;
+       $call = shift if ref $call;
+       return $list{uc $call};
+}
+
+sub adddxchan
+{
+       my $self = shift;
+    $self->_addlist('dxchancall', @_);
+}
+
+sub deldxchan
+{
+       my $self = shift;
+    $self->_dellist('dxchancall', @_);
+}
+
+sub addparent
+{
+       my $self = shift;
+    $self->_addlist('parent', @_);
+}
+
+sub delparent
+{
+       my $self = shift;
+    $self->_dellist('parent', @_);
+}
+
+1;
+

diff --git a/perl/Route/User.pm b/perl/Route/User.pm
new file mode 100644 (file)
index 0000000..274b26f
--- /dev/null
+++ b/perl/Route/User.pm
@@ -0,0 +1,57 @@
+#
+# User routing routines
+#
+# Copyright (c) 2001 Dirk Koopman G1TLH
+#
+# $Id$
+# 
+
+package Route::User;
+
+use DXDebug;
+use Route;
+
+use strict;
+
+use vars qw(%list %valid @ISA);
+@ISA = qw(Route);
+
+%valid = (
+                 node => '0,Node Calls,parray',
+);
+
+%list = ();
+
+sub new
+{
+       my $pkg = shift;
+       my $call = uc shift;
+       confess "already have $call in $pkg" if $list{$call};
+       
+       my $self = $pkg->SUPER::new($call);
+       $self->{node} = [ ];
+       $list{$call} = $self;
+       
+       return $self;
+}
+
+sub get
+{
+       my $call = shift;
+       $call = shift if ref $call;
+       return $list{uc $call};
+}
+
+sub addnode
+{
+       my $self = shift;
+    $self->_addlist('node', @_);
+}
+
+sub delnode
+{
+       my $self = shift;
+    $self->_dellist('node', @_);
+}
+
+1;

diff --git a/perl/cluster.pl b/perl/cluster.pl
index d321cba5fcd9b971e4cb048857aa539065daa253..320ed037b6a3f822e5aab6ea8d2218a41fc2cd41 100755 (executable)
--- a/perl/cluster.pl
+++ b/perl/cluster.pl
@@ -82,6 +82,9 @@ use BBS;
 use WCY;
 use BadWords;
 use Timer;
+use Route;
+use Route::Node;
+use Route::User;
 
 use Data::Dumper;
 use IO::File;
@@ -430,6 +433,7 @@ Spot->init();
 
 # initialise the protocol engine
 dbg('err', "reading in duplicate spot and WWV info ...");
+Route::Node::init($mycall, $version);
 DXProt->init();
 
 # put in a DXCluster node for us here so we can add users and take them away