From fdc49835d7dc5573453567bd41e52c5e580ad8e7 Mon Sep 17 00:00:00 2001 From: minima Date: Tue, 15 May 2001 16:10:29 +0000 Subject: [PATCH] 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. --- Changes | 3 ++ cmd/stat/channel.pl | 2 +- perl/DXMsg.pm | 32 +++++++++--------- perl/DXProt.pm | 2 ++ perl/Route/Node.pm | 80 +++++++++++++++++++++++++++++++++++++++++++++ perl/Route/User.pm | 57 ++++++++++++++++++++++++++++++++ perl/cluster.pl | 4 +++ 7 files changed, 163 insertions(+), 17 deletions(-) create mode 100644 perl/Route/Node.pm create mode 100644 perl/Route/User.pm diff --git a/Changes b/Changes index 632b8b9c..ec8c2aeb 100644 --- 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 8b20e0cb..d963eb45 100644 --- 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 cb71c97d..d5631904 100644 --- 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 1ba185b1..decd71f6 100644 --- 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 index 00000000..2fee0acd --- /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 index 00000000..274b26fe --- /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 d321cba5..320ed037 100755 --- 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 -- 2.34.1