From febdc9bd8f6cd065d217ba089fab4361e9980f35 Mon Sep 17 00:00:00 2001 From: minima Date: Fri, 8 Jun 2001 16:02:40 +0000 Subject: [PATCH] 1. first cut with new routing code. Created NEW_ROUTE branch 2. added acc/route and rej/route commands 3. added stat/route_node and stat/route_user commands to look at the routing table entities --- Changes | 5 + cmd/dbshow.pl | 2 +- cmd/disconnect.pl | 12 +- cmd/init.pl | 11 +- cmd/merge.pl | 3 +- cmd/ping.pl | 3 +- cmd/rcmd.pl | 6 +- cmd/rinit.pl | 11 +- cmd/show/configuration.pl | 14 +- cmd/show/users.pl | 32 +-- cmd/talk.pl | 2 +- perl/AnnTalk.pm | 6 +- perl/DXChannel.pm | 16 +- perl/DXCommandmode.pm | 35 +--- perl/DXCron.pm | 33 ++- perl/DXDebug.pm | 7 +- perl/DXMsg.pm | 13 +- perl/DXProt.pm | 418 +++++++++++++++----------------------- perl/DXProtout.pm | 61 +++--- perl/Route.pm | 108 +++++++++- perl/Route/Node.pm | 80 ++++++-- perl/Route/User.pm | 9 +- perl/cluster.pl | 25 +-- 23 files changed, 480 insertions(+), 432 deletions(-) diff --git a/Changes b/Changes index b1241856..26935f1a 100644 --- a/Changes +++ b/Changes @@ -1,3 +1,8 @@ +08Jun01======================================================================= +1. first cut with new routing code. Created NEW_ROUTE branch +2. added acc/route and rej/route commands +3. added stat/route_node and stat/route_user commands to look at the routing +table entities 07Jun01======================================================================= 1. move userconfig.pl and nodeconfig.pl to stat/ 2. fix problem with locally connected users not being removed from the diff --git a/cmd/dbshow.pl b/cmd/dbshow.pl index 503eafd1..1835ed39 100644 --- a/cmd/dbshow.pl +++ b/cmd/dbshow.pl @@ -24,7 +24,7 @@ foreach $n (@db) { if ($db->remote) { # remote databases - unless (DXCluster->get_exact($db->remote) || DXChannel->get($db->remote)) { + unless (Route::Node::get($db->remote) || DXChannel->get($db->remote)) { push @out, $self->msg('db4', uc $name, $db->remote); last; } diff --git a/cmd/disconnect.pl b/cmd/disconnect.pl index 9acf0ce3..afe9b541 100644 --- a/cmd/disconnect.pl +++ b/cmd/disconnect.pl @@ -26,12 +26,12 @@ 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 $dxchancall = $ref->dxchancall; - if ($dxchancall eq $main::mycall || !DXChannel->get($dxchancall)) { - $ref->del; - push @out, $self->msg('disc4', $call); - } +# } 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); +# } } else { push @out, $self->msg('e10', $call); } diff --git a/cmd/init.pl b/cmd/init.pl index b88ed013..2d0a38fc 100644 --- a/cmd/init.pl +++ b/cmd/init.pl @@ -20,14 +20,9 @@ foreach $call (@calls) { if ($dxchan->is_node) { # first clear out any nodes on this dxchannel - my @gonenodes = grep { $_->dxchan == $dxchan } DXNode::get_all(); - foreach my $node (@gonenodes) { - next if $node->dxchan == $DXProt::me; - next unless $node->dxchan == $dxchan; - DXProt::broadcast_ak1a(DXProt::pc21($node->call, 'Gone, re-init') , $dxchan) unless $dxchan->{isolate}; - $node->del(); - } -# $dxchan->send(DXProt::pc38()); + my $node = Route::Node::get($self->{call}); + my @rout = $node->del_nodes if $node; + DXProt::route_pc21($self, @rout); $dxchan->send(DXProt::pc18()); $dxchan->state('init'); push @out, $self->msg('init1', $call); diff --git a/cmd/merge.pl b/cmd/merge.pl index 4e35cb8b..87a9827e 100644 --- a/cmd/merge.pl +++ b/cmd/merge.pl @@ -16,10 +16,9 @@ return (1, $self->msg('e12')) if !$f[0]; my $call = uc $f[0]; return (1, $self->msg('e11')) if $call eq $main::mycall; -my $ref = DXCluster->get_exact($call); +my $ref = Route::Node:get($call); my $dxchan = $ref->dxchan if $ref; return (1, $self->msg('e10', $call)) unless $ref; -return (1, $self->msg('e13', $call)) unless $ref->isa('DXNode'); my ($spots, $wwv) = $f[1] =~ m{(\d+)/(\d+)} if $f[1]; diff --git a/cmd/ping.pl b/cmd/ping.pl index d75e1701..05ccd829 100644 --- a/cmd/ping.pl +++ b/cmd/ping.pl @@ -20,8 +20,7 @@ return (1, $self->msg('e6')) if !$call; return (1, $self->msg('pinge1')) if $call eq $main::mycall; # can we see it? Is it a node? -my $noderef = DXCluster->get_exact($call); -$noderef = DXChannel->get($call) unless $noderef; +my $noderef = Route::Node::get($call); return (1, $self->msg('e7', $call)) unless $noderef; diff --git a/cmd/rcmd.pl b/cmd/rcmd.pl index 8afb5b45..31a02181 100644 --- a/cmd/rcmd.pl +++ b/cmd/rcmd.pl @@ -22,11 +22,7 @@ $line =~ s/^\s*$call\s+//; # can we see it? Is it a node? $call = uc $call; -my $noderef = DXCluster->get_exact($call); -unless ($noderef) { - $noderef = DXChannel->get($call); - $noderef = undef unless $noderef && $noderef->is_node; -} +my $noderef = Route::Node::get($call); return (1, $self->msg('e7', $call)) unless $noderef; # rcmd it diff --git a/cmd/rinit.pl b/cmd/rinit.pl index 93748ca1..b49b2dbe 100644 --- a/cmd/rinit.pl +++ b/cmd/rinit.pl @@ -20,14 +20,9 @@ foreach $call (@calls) { if ($dxchan->is_node) { # first clear out any nodes on this dxchannel - my @gonenodes = grep { $_->dxchan == $dxchan } DXNode::get_all(); - foreach my $node (@gonenodes) { - next if $node->dxchan == $DXProt::me; - next unless $node->dxchan == $dxchan; - DXProt::broadcast_ak1a(DXProt::pc21($node->call, 'Gone, re-init') , $dxchan) unless $dxchan->{isolate}; - $node->del(); - } -# $dxchan->send(DXProt::pc38()); + my $node = Route::Node::get($self->{call}); + my @rout = $node->del_nodes if $node; + DXProt::route_pc21($self, @rout); $dxchan->send(DXProt::pc20()); $dxchan->state('init'); push @out, $self->msg('init1', $call); diff --git a/cmd/show/configuration.pl b/cmd/show/configuration.pl index ba0f3878..95211a0f 100644 --- a/cmd/show/configuration.pl +++ b/cmd/show/configuration.pl @@ -9,7 +9,7 @@ my ($self, $line) = @_; my @list = map { uc } split /\s+/, $line; # list of callsigns of nodes my @out; -my @nodes = sort {$a->call cmp $b->call} (DXNode::get_all()); +my @nodes = sort {$a->call cmp $b->call} (Route::Node::get_all()); my $node; my @l; my @val; @@ -49,12 +49,11 @@ if ($list[0] && $list[0] =~ /^NOD/) { $call = "($call)" if $node->here == 0; @l = (); push @l, $call; - my $nlist = $node->list; - @val = sort {$a->call cmp $b->call} values %{$nlist}; + @val = sort $node->users; my $i = 0; - if (@val == 0 && $node->users) { - push @l, sprintf "(%d users)", $node->users; + if (@val == 0 && $node->usercount) { + push @l, sprintf "(%d users)", $node->usercount; } foreach $call (@val) { if ($i >= 5) { @@ -63,8 +62,9 @@ if ($list[0] && $list[0] =~ /^NOD/) { push @l, ""; $i = 0; } - my $s = $call->{call}; - $s = sprintf "(%s)", $s if $call->{here} == 0; + my $uref = Route::User::get($call); + my $s = $call; + $s = sprintf "(%s)", $s unless $uref->here; push @l, $s; $i++; } diff --git a/cmd/show/users.pl b/cmd/show/users.pl index 55a34bec..320e9b4b 100644 --- a/cmd/show/users.pl +++ b/cmd/show/users.pl @@ -7,29 +7,29 @@ # my ($self, $line) = @_; -my @list = map { uc } split /\s+/, $line; # list of callsigns of nodes +my @list = map { uc } split /\s+/, $line; # list of callsigns of nodes my @out; -my $node = (DXNode->get($main::mycall)); +my $node = $main::routeroot; push @out, "Callsigns connected to $main::mycall"; my $call; my $i = 0; my @l; -my $nlist = $node->list; -my @val = sort {$a->call cmp $b->call} values %{$nlist}; +my @val = sort $node->users; foreach $call (@val) { - if (@list) { - next if !grep $call->call eq $_, @list; - } - if ($i >= 5) { - push @out, sprintf "%-12s %-12s %-12s %-12s %-12s %-12s", @l; - @l = (); - $i = 0; - } - my $s = $call->{call}; - $s = sprintf "(%s)", $s if $call->{here} == 0; - push @l, $s; - $i++; + if (@list) { + next if !grep $call eq $_, @list; + } + if ($i >= 5) { + push @out, sprintf "%-12s %-12s %-12s %-12s %-12s %-12s", @l; + @l = (); + $i = 0; + } + my $uref = Route::User::get($call); + my $s = $call; + $s = sprintf "(%s)", $s unless $uref->here; + push @l, $s; + $i++; } push @out, sprintf "%-12s %-12s %-12s %-12s %-12s %-12s", @l; diff --git a/cmd/talk.pl b/cmd/talk.pl index 8082e240..45ac857e 100644 --- a/cmd/talk.pl +++ b/cmd/talk.pl @@ -31,7 +31,7 @@ if ($via) { $to = uc $to if $to; $via = uc $via if $via; my $call = $via ? $via : $to; -my $clref = DXCluster->get_exact($call); # try an exact call +my $clref = Route::get($call); # try an exact call my $dxchan = $clref->dxchan if $clref; return (1, $self->msg('e7', $call)) unless $dxchan; diff --git a/perl/AnnTalk.pm b/perl/AnnTalk.pm index b7eb1311..f9fd7828 100644 --- a/perl/AnnTalk.pm +++ b/perl/AnnTalk.pm @@ -31,9 +31,9 @@ $filterdef = bless ([ ['by_dxcc', 'n', 7], ['by_itu', 'n', 8], ['by_zone', 'n', 9], - ['origin_dxcc', 'c', 10], - ['origin_itu', 'c', 11], - ['origin_itu', 'c', 12], + ['origin_dxcc', 'n', 10], + ['origin_itu', 'n', 11], + ['origin_itu', 'n', 12], ], 'Filter::Cmd'); diff --git a/perl/DXChannel.pm b/perl/DXChannel.pm index 8a300d5f..e7022222 100644 --- a/perl/DXChannel.pm +++ b/perl/DXChannel.pm @@ -31,6 +31,7 @@ use DXUtil; use DXVars; use DXDebug; use Filter; +use Prefix; use strict; use vars qw(%channels %valid @ISA $count); @@ -58,7 +59,7 @@ $count = 0; talk => '0,Want Talk,yesno', ann => '0,Want Announce,yesno', here => '0,Here?,yesno', - confmode => '0,In Conference?,yesno', + conf => '0,In Conference?,yesno', dx => '0,DX Spots,yesno', redirect => '0,Redirect messages to', lang => '0,Language', @@ -77,10 +78,12 @@ $count = 0; wwvfilter => '5,WWV Filter', wcyfilter => '5,WCY Filter', spotsfilter => '5,Spot Filter', + routefilter => '5,route Filter', inannfilter => '5,Input Ann Filter', inwwvfilter => '5,Input WWV Filter', inwcyfilter => '5,Input WCY Filter', inspotsfilter => '5,Input Spot Filter', + inroutefilter => '5,Input Route Filter', passwd => '9,Passwd List,parray', pingint => '5,Ping Interval ', nopings => '5,Ping Obs Count', @@ -93,6 +96,9 @@ $count = 0; isbasic => '9,Internal Connection', errors => '9,Errors', route => '9,Route Data', + dxcc => '0,Country Code', + itu => '0,ITU Zone', + cq => '0,CQ Zone', ); # object destruction @@ -131,6 +137,14 @@ sub alloc $self->{lang} = $main::lang if !$self->{lang}; $self->{func} = ""; + # add in all the dxcc, itu, zone info + my @dxcc = Prefix::extract($call); + if (@dxcc > 0) { + $self->{dxcc} = $dxcc[1]->dxcc; + $self->{itu} = $dxcc[1]->itu; + $self->{cq} = $dxcc[1]->cq; + } + $count++; dbg('chan', "DXChannel $self->{call} created ($count)"); bless $self, $pkg; diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm index fc43a4e1..8c7b67fd 100644 --- a/perl/DXCommandmode.pm +++ b/perl/DXCommandmode.pm @@ -98,26 +98,16 @@ sub start $user->qra(DXBearing::lltoqra($lat, $long)) if (defined $lat && defined $long); } - # add yourself to the database - my $node = DXNode->get($main::mycall) or die "$main::mycall not allocated in DXNode database"; - my $cuser = DXNodeuser->new($self, $node, $call, 0, 1); - $node->dxchan($self) if $call eq $main::myalias; # send all output for mycall to myalias + $DXProt::me->conn($self->conn) if $call eq $main::myalias; # send all output for mycall to myalias # routing version - my $pref = Route::Node::get($main::mycall) or die "$main::mycall not allocated in Route database"; - $pref->add_user($call, Route::here($self->{here})); - dbg('route', "B/C PC16 on $main::mycall for: $call"); - - # issue a pc16 to everybody interested - my $nchan = DXChannel->get($main::mycall); - my @pc16 = DXProt::pc16($nchan, $cuser); - for (@pc16) { - DXProt::broadcast_all_ak1a($_); - } + my @rout = $main::routeroot->add_user($call, Route::here($self->{here})); + dbg('route', "B/C PC16 on $main::mycall for: $call") if @rout; + DXProt::route_pc16($DXProt::me, $main::routeroot, @rout) if @rout; Log('DXCommand', "$call connected"); # send prompts and things - my $info = DXCluster::cluster(); + my $info = Route::cluster(); $self->send("Cluster:$info"); $self->send($self->msg('namee1')) if !$user->name; $self->send($self->msg('qthe1')) if !$user->qth; @@ -227,7 +217,7 @@ sub send_talks my ($to, $via) = $ent =~ /(\S+)>(\S+)/; $to = $ent unless $to; my $call = $via ? $via : $to; - my $clref = DXCluster->get_exact($call); + my $clref = Route::get($call); my $dxchan = $clref->dxchan if $clref; if ($dxchan) { $dxchan->talk($self->{call}, $to, $via, $line); @@ -412,27 +402,22 @@ sub disconnect # reset the redirection of messages back to 'normal' if we are the sysop if ($call eq $main::myalias) { - my $node = DXNode->get($main::mycall) or die "$main::mycall not allocated in DXNode database"; - $node->dxchan($DXProt::me); + $DXProt::me->conn(undef); } my @rout = $main::routeroot->del_user($call); dbg('route', "B/C PC17 on $main::mycall for: $call"); + # issue a pc17 to everybody interested + DXProt::route_pc17($DXProt::me, $main::routeroot, @rout) if @rout; + # I was the last node visited $self->user->node($main::mycall); - # issue a pc17 to everybody interested - my $nchan = DXChannel->get($main::mycall); - my $pc17 = $nchan->pc17($self); - DXProt::broadcast_all_ak1a($pc17); - # send info to all logged in thingies $self->tell_login('logoutu'); Log('DXCommand', "$call disconnected"); - my $ref = DXCluster->get_exact($call); - $ref->del() if $ref; $self->SUPER::disconnect; } diff --git a/perl/DXCron.pm b/perl/DXCron.pm index c88ad1d3..39776dcc 100644 --- a/perl/DXCron.pm +++ b/perl/DXCron.pm @@ -175,32 +175,43 @@ sub connected sub present { my $call = uc shift; - return DXCluster->get_exact($call); + return Route::get($call); } # is it remotely connected anywhere (ignoring SSIDS)? sub presentish { my $call = uc shift; - return DXCluster->get($call); + my $c = Route::get($call); + unless ($c) { + for (1..15) { + $c = Route::get("$call-$_"); + last if $c; + } + } + return $c; } # is it remotely connected anywhere (with exact callsign) and on node? sub present_on { my $call = uc shift; - my $node = uc shift; - my $ref = DXCluster->get_exact($call); - return ($ref && $ref->mynode) ? $ref->mynode->call eq $node : undef; + my $ncall = uc shift; + my $node = Route::Node::get($ncall); + return ($node) ? grep $call eq $_, $node->users : undef; } -# is it remotely connected anywhere (ignoring SSIDS) and on node? +# is it remotely connected (ignoring SSIDS) and on node? sub presentish_on { my $call = uc shift; - my $node = uc shift; - my $ref = DXCluster->get($call); - return ($ref && $ref->mynode) ? $ref->mynode->call eq $node : undef; + my $ncall = uc shift; + my $node = Route::Node::get($ncall); + my $present; + if ($node) { + $present = grep {/^$call/ } $node->users; + } + return $present; } # last time this thing was connected @@ -265,8 +276,8 @@ sub rcmd my $line = shift; # can we see it? Is it a node? - my $noderef = DXCluster->get_exact($call); - return if !$noderef || !$noderef->pcversion; + my $noderef = Route::Node::get($call); + return unless $noderef && $noderef->version; # send it DXProt::addrcmd($DXProt::me, $call, $line); diff --git a/perl/DXDebug.pm b/perl/DXDebug.pm index 766dacbd..f7598c15 100644 --- a/perl/DXDebug.pm +++ b/perl/DXDebug.pm @@ -43,9 +43,10 @@ if (!defined $DB::VERSION) { CORE::die(Carp::shortmess($@)) if $@; } else { - eval qq( sub confess { Carp::confess(\@_); }; - sub croak { Carp::croak(\@_); }; - sub cluck { Carp::cluck(\@_); }; + eval qq( sub confess { die Carp::longmess(\@_); }; + sub croak { die Carp::shortmess(\@_); }; + sub cluck { warn Carp::longmess(\@_); }; + sub carp { warn Carp::shortmess(\@_); }; ); } diff --git a/perl/DXMsg.pm b/perl/DXMsg.pm index 428f87e9..3063948a 100644 --- a/perl/DXMsg.pm +++ b/perl/DXMsg.pm @@ -19,7 +19,6 @@ use DXUtil; use DXChannel; use DXUser; use DXM; -use DXCluster; use DXProtVars; use DXProtout; use DXDebug; @@ -607,12 +606,12 @@ sub queue_msg my $dxchan; if ($ref->{private}) { next if $ref->{'read'}; # if it is read, it is stuck here - $clref = DXCluster->get_exact($ref->{to}); - unless ($clref) { # otherwise look for a homenode - my $uref = DXUser->get_current($ref->{to}); - my $hnode = $uref->homenode if $uref; - $clref = DXCluster->get_exact($hnode) if $hnode; - } + $clref = Route::get($ref->{to}); +# unless ($clref) { # otherwise look for a homenode +# my $uref = DXUser->get_current($ref->{to}); +# my $hnode = $uref->homenode if $uref; +# $clref = Route::Node::get($hnode) if $hnode; +# } if ($clref && !grep { $clref->dxchan == $_ } DXCommandmode::get_all()) { next if $clref->call eq $main::mycall; # i.e. it lives here $dxchan = $clref->dxchan; diff --git a/perl/DXProt.pm b/perl/DXProt.pm index 0fce7f25..06cf1007 100644 --- a/perl/DXProt.pm +++ b/perl/DXProt.pm @@ -15,7 +15,6 @@ use DXUtil; use DXChannel; use DXUser; use DXM; -use DXCluster; use DXProtVars; use DXCommandmode; use DXLog; @@ -218,6 +217,7 @@ sub start $self->{wwvfilter} = Filter::read_in('wwv', $call, 0) || Filter::read_in('wwv', 'node_default', 0); $self->{wcyfilter} = Filter::read_in('wcy', $call, 0) || Filter::read_in('wcy', 'node_default', 0); $self->{annfilter} = Filter::read_in('ann', $call, 0) || Filter::read_in('ann', 'node_default', 0) ; + $self->{routefilter} = Filter::read_in('route', $call, 0) || Filter::read_in('route', 'node_default', 0) ; # get the INPUT filters (these only pertain to Clusters) @@ -225,6 +225,7 @@ sub start $self->{inwwvfilter} = Filter::read_in('wwv', $call, 1) || Filter::read_in('wwv', 'node_default', 1); $self->{inwcyfilter} = Filter::read_in('wcy', $call, 1) || Filter::read_in('wcy', 'node_default', 1); $self->{inannfilter} = Filter::read_in('ann', $call, 1) || Filter::read_in('ann', 'node_default', 1); + $self->{inroutefilter} = Filter::read_in('route', $call, 1) || Filter::read_in('route', 'node_default', 1); # set unbuffered and no echo $self->send_now('B',"0"); @@ -251,7 +252,9 @@ sub start # send info to all logged in thingies $self->tell_login('loginn'); + # add this node to the table, the values get filled in later $main::routeroot->add($call); + Log('DXProt', "$call connected"); } @@ -416,18 +419,20 @@ sub normal my $node; my $to = $user->homenode; my $last = $user->lastoper || 0; - if ($send_opernam && $main::systime > $last + $DXUser::lastoperinterval && $to && ($node = DXCluster->get_exact($to)) ) { + if ($send_opernam && $main::systime > $last + $DXUser::lastoperinterval && $to && ($node = Route::Node::get($to)) ) { my $cmd = "forward/opernam $spot[4]"; # send the rcmd but we aren't interested in the replies... - if ($node && $node->dxchan && $node->dxchan->is_clx) { + my $dxchan = $node->dxchan; + if ($dxchan && $dxchan->is_clx) { route(undef, $to, pc84($main::mycall, $to, $main::mycall, $cmd)); } else { route(undef, $to, pc34($main::mycall, $to, $cmd)); } if ($to ne $field[7]) { $to = $field[7]; - $node = DXCluster->get_exact($to); - if ($node && $node->dxchan && $node->dxchan->is_clx) { + $node = Route::Node::get($to); + $dxchan = $node->dxchan; + if ($node->dxchan && $dxchan->is_clx) { route(undef, $to, pc84($main::mycall, $to, $main::mycall, $cmd)); } else { route(undef, $to, pc34($main::mycall, $to, $cmd)); @@ -519,6 +524,8 @@ sub normal # general checks my $dxchan; + my $newline = "PC16^"; + if ($field[1] eq $main::mycall || $field[2] eq $main::mycall) { dbg('chan', "PCPROT: trying to alter config on this node from outside!"); return; @@ -532,69 +539,37 @@ sub normal return; } - my $node = DXCluster->get_exact($field[1]); + my $node = Route::Node::get($field[1]); unless ($node) { dbg('chan', "PCPROT: Node $field[1] not in config"); return; } - my $pref = Route::Node::get($field[1]); - unless ($pref) { - dbg('chan', "PCPROT: Route::Node $field[1] not in config"); - return; - } - my $wrong; - unless ($node->isa('DXNode')) { - dbg('chan', "PCPROT: $field[1] is not a node"); - $wrong = 1; - } - if ($node->dxchan != $self) { - dbg('chan', "PCPROT: $field[1] came in on wrong channel"); - $wrong = 1; - } my $i; my @rout; for ($i = 2; $i < $#field; $i++) { - my ($call, $confmode, $here) = $field[$i] =~ /^(\S+) (\S) (\d)/o; - next unless $call && $confmode && defined $here && is_callsign($call); - $confmode = $confmode eq '*'; + my ($call, $conf, $here) = $field[$i] =~ /^(\S+) (\S) (\d)/o; + next unless $call && $conf && defined $here && is_callsign($call); + $conf = $conf eq '*'; - push @rout, $pref->add_user($call, Route::here($here)|Route::conf($confmode)); + push @rout, $node->add_user($call, Route::here($here)|Route::conf($conf)); - unless ($wrong) { - my $ref = DXCluster->get_exact($call); - if ($ref) { - if ($ref->isa('DXNode')) { - dbg('chan', "PCPROT: $call is a node"); - next; - } - my $rcall = $ref->mynode->call; - dbg('chan', "PCPROT: already have $call on $rcall"); - next; - } - - DXNodeuser->new($self, $node, $call, $confmode, $here); - - # add this station to the user database, if required - $call =~ s/-\d+$//o; # remove ssid for users - my $user = DXUser->get_current($call); - $user = DXUser->new($call) if !$user; - $user->homenode($node->call) if !$user->homenode; - $user->node($node->call); - $user->lastin($main::systime) unless DXChannel->get($call); - $user->put; - } + # add this station to the user database, if required + $call =~ s/-\d+$//o; # remove ssid for users + my $user = DXUser->get_current($call); + $user = DXUser->new($call) if !$user; + $user->homenode($node->call) if !$user->homenode; + $user->node($node->call); + $user->lastin($main::systime) unless DXChannel->get($call); + $user->put; } - dbg('route', "B/C PC16 on $field[1] for: " . join(',', map{$_->call} @rout)) if @rout; - - # all these 'wrong' is just while we are swopping over to the Route stuff - return if $wrong; # queue up any messages (look for privates only) DXMsg::queue_msg(1) if $self->state eq 'normal'; -# broadcast_route($line, $self, $field[1]); -# return; - last SWITCH; + + dbg('route', "B/C PC16 on $field[1] for: " . join(',', map{$_->call} @rout)) if @rout; + $self->route_pc16($node, @rout) if @rout; + return; } if ($pcno == 17) { # remove a user @@ -612,53 +587,27 @@ sub normal return; } - my $pref = Route::Node::get($field[2]); - unless ($pref) { + my $node = Route::Node::get($field[2]); + unless ($node) { dbg('chan', "PCPROT: Route::Node $field[2] not in config"); return; } - $pref->del_user($field[1]); + my @rout = $node->del_user($field[1]); dbg('route', "B/C PC17 on $field[2] for: $field[1]"); - - my $node = DXCluster->get_exact($field[2]); - unless ($node) { - dbg('chan', "PCPROT: Node $field[2] not in config"); - return; - } - unless ($node->isa('DXNode')) { - dbg('chan', "PCPROT: $field[2] is not a node"); - return; - } - if ($node->dxchan != $self) { - dbg('chan', "PCPROT: $field[2] came in on wrong channel"); - return; - } - my $ref = DXCluster->get_exact($field[1]); - if ($ref) { - if ($ref->mynode != $node) { - dbg('chan', "PCPROT: $field[1] came in from wrong node $field[2]"); - return; - } - $ref->del; - } else { - dbg('chan', "PCPROT: $field[1] not known" ); - return; - } -# broadcast_route($line, $self, $field[2]); -# return; - last SWITCH; + $self->route_pc17($node, @rout) if @rout; + return; } if ($pcno == 18) { # link request $self->state('init'); # first clear out any nodes on this dxchannel - my @gonenodes = map { $_->dxchan == $self ? $_ : () } DXNode::get_all(); - foreach my $node (@gonenodes) { - next if $node->dxchan == $DXProt::me; - broadcast_ak1a(pc21($node->call, 'Gone, re-init') , $self) unless $self->{isolate}; - $node->del(); + my $node = Route::Node::get($self->{call}); + my @rout; + for ($node->nodes) { + push @rout, $_->del_node; } + $self->route_pc21(@rout, $node); $self->send_local_config(); $self->send(pc20()); return; # we don't pass these on @@ -670,60 +619,30 @@ sub normal # new routing list my @rout; - my $pref = Route::Node::get($self->{call}); + my $node = Route::Node::get($self->{call}); # parse the PC19 for ($i = 1; $i < $#field-1; $i += 4) { my $here = $field[$i]; my $call = uc $field[$i+1]; - my $confmode = $field[$i+2]; + my $conf = $field[$i+2]; my $ver = $field[$i+3]; - next unless defined $here && defined $confmode && is_callsign($call); + next unless defined $here && defined $conf && is_callsign($call); # check for sane parameters $ver = 5000 if $ver eq '0000'; next if $ver < 5000; # only works with version 5 software next if length $call < 3; # min 3 letter callsigns - - # now check the call over - my $node = DXCluster->get_exact($call); - if ($node) { - my $dxchan; - if ((my $dxchan = DXChannel->get($call)) && $dxchan != $self) { - dbg('chan', "PCPROT: $call connected locally"); - } - if ($node->dxchan != $self) { - dbg('chan', "PCPROT: $call come in on wrong channel"); - next; - } - - # add a route object - if ($call eq $pref->call && !$pref->version) { - $pref->version($ver); - $pref->flags(Route::here($here)|Route::conf($confmode)); - } else { - my $r = $pref->add($call, $ver, Route::here($here)|Route::conf($confmode)); - push @rout, $r if $r; - } - - my $rcall = $node->mynode->call; - dbg('chan', "PCPROT: already have $call on $rcall"); - next; - } - - # add a route object - if ($call eq $pref->call && !$pref->version) { - $pref->version($ver); - $pref->flags(Route::here($here)|Route::conf($confmode)); - } else { - my $r = $pref->add($call, $ver, Route::here($here)|Route::conf($confmode)); + # update it if required + if ($node->call eq $call && !$node->version) { + $node->version($ver); + $node->flags(Route::here($here)|Route::conf($conf)); + push @rout, $node; + } elsif ($node->call ne $call) { + my $r = $node->add($call, $ver, Route::here($here)|Route::conf($conf)); push @rout, $r if $r; } - # add it to the nodes table and outgoing line - $newline .= "$here^$call^$confmode^$ver^"; - DXNode->new($self, $call, $confmode, $here, $ver); - # unbusy and stop and outgoing mail (ie if somehow we receive another PC19 without a disconnect) my $mref = DXMsg::get_busy($call); $mref->stop_msg($call) if $mref; @@ -744,12 +663,8 @@ sub normal dbg('route', "B/C PC19 for: " . join(',', map{$_->call} @rout)) if @rout; - return if $newline eq "PC19^"; - - # add hop count - $newline .= get_hops(19) . "^"; - $line = $newline; - last SWITCH; + $self->route_pc19(@rout) if @rout; + return; } if ($pcno == 20) { # send local configuration @@ -762,39 +677,19 @@ sub normal if ($pcno == 21) { # delete a cluster from the list my $call = uc $field[1]; my @rout; - my $pref = Route::Node::get($call); + my $node = Route::Node::get($call); if ($call ne $main::mycall) { # don't allow malicious buggers to disconnect me! if ($call eq $self->{call}) { dbg('chan', "PCPROT: Trying to disconnect myself with PC21"); return; } - if (my $dxchan = DXChannel->get($call)) { - dbg('chan', "PCPROT: $call connected locally"); - return; - } # routing objects - if ($pref) { - push @rout, $pref->del_node($call); - } else { - dbg('chan', "PCPROT: Route::Node $call not in config"); - } - - my $node = DXCluster->get_exact($call); if ($node) { - unless ($node->isa('DXNode')) { - dbg('chan', "PCPROT: $call is not a node"); - return; - } - if ($node->dxchan != $self) { - dbg('chan', "PCPROT: $call come in on wrong channel"); - return; - } - $node->del(); + push @rout, $node->del_node($call); } else { - dbg('chan', "PCPROT: $call not in table, dropped"); - return; + dbg('chan', "PCPROT: Route::Node $call not in config"); } } else { dbg('chan', "PCPROT: I WILL _NOT_ be disconnected!"); @@ -802,9 +697,8 @@ sub normal } dbg('route', "B/C PC21 for: " . join(',', (map{$_->call} @rout))) if @rout; -# broadcast_route($line, $self, $call); -# return; - last SWITCH; + $self->route_pc21(@rout) if @rout; + return; } if ($pcno == 22) { @@ -858,7 +752,9 @@ sub normal if ($pcno == 24) { # set here status my $call = uc $field[1]; - my $ref = DXCluster->get_exact($call); + my $ref = Route::Node::get($call); + $ref->here($field[2]) if $ref; + $ref = Route::User::get($call); $ref->here($field[2]) if $ref; last SWITCH; } @@ -907,9 +803,9 @@ sub normal if ($pcno == 34 || $pcno == 36) { # remote commands (incoming) if ($field[1] eq $main::mycall) { my $ref = DXUser->get_current($field[2]); - my $cref = DXCluster->get($field[2]); + my $cref = Route::Node::get($field[2]); Log('rcmd', 'in', $ref->{priv}, $field[2], $field[3]); - unless (!$cref || !$ref || $cref->mynode->call ne $ref->homenode) { # not allowed to relay RCMDS! + unless (!$cref || !$ref || $cref->call ne $ref->homenode) { # not allowed to relay RCMDS! if ($ref->{priv}) { # you have to have SOME privilege, the commands have further filtering $self->{remotecmd} = 1; # for the benefit of any command that needs to know my $oldpriv = $self->{priv}; @@ -1007,11 +903,10 @@ sub normal } if ($pcno == 50) { # keep alive/user list - my $node = DXCluster->get_exact($field[1]); + my $node = Route::Node::get($field[1]); if ($node) { - return unless $node->isa('DXNode'); - return unless $node->dxchan == $self; - $node->update_users($field[2]); + return unless $node->call eq $self->{call}; + $node->usercount($field[2]); } last SWITCH; } @@ -1097,9 +992,9 @@ sub normal if ($pcno == 84) { # remote commands (incoming) if ($field[1] eq $main::mycall) { my $ref = DXUser->get_current($field[2]); - my $cref = DXCluster->get($field[2]); + my $cref = Route::Node::get($field[2]); Log('rcmd', 'in', $ref->{priv}, $field[2], $field[4]); - unless ($field[4] =~ /rcmd/i || !$cref || !$ref || $cref->mynode->call ne $ref->homenode) { # not allowed to relay RCMDS! + unless ($field[4] =~ /rcmd/i || !$cref || !$ref || $cref->call ne $ref->homenode) { # not allowed to relay RCMDS! if ($ref->{priv}) { # you have to have SOME privilege, the commands have further filtering $self->{remotecmd} = 1; # for the benefit of any command that needs to know my $oldpriv = $self->{priv}; @@ -1222,38 +1117,6 @@ sub process # # some active measures # -sub send_route -{ - my $self = shift; - my $line = shift; - my @dxchan = DXChannel::get_all_nodes(); - my $dxchan; - - # send it if it isn't the except list and isn't isolated and still has a hop count - # taking into account filtering and so on - foreach $dxchan (@dxchan) { - my $routeit; - my ($filter, $hops); - - if ($dxchan->{routefilter}) { - ($filter, $hops) = $dxchan->{routefilter}->it($self->{call}, @_); - next unless $filter; - } - next if $dxchan == $self; - if ($hops) { - $routeit = $line; - $routeit =~ s/\^H\d+\^\~$/\^H$hops\^\~/; - } else { - $routeit = adjust_hops($dxchan, $line); # adjust its hop count by node name - next unless $routeit; - } - if ($filter) { - $dxchan->send($routeit) if $routeit; - } else { - $dxchan->send($routeit) unless $dxchan->{isolate} || $self->{isolate}; - } - } -} sub send_dx_spot { @@ -1265,6 +1128,7 @@ sub send_dx_spot # send it if it isn't the except list and isn't isolated and still has a hop count # taking into account filtering and so on foreach $dxchan (@dxchan) { + next if $dxchan == $me; my $routeit; my ($filter, $hops); @@ -1323,6 +1187,8 @@ sub send_wwv_spot # send it if it isn't the except list and isn't isolated and still has a hop count # taking into account filtering and so on foreach $dxchan (@dxchan) { + next if $dxchan == $self; + next if $dxchan == $me; my $routeit; my ($filter, $hops); @@ -1331,7 +1197,6 @@ sub send_wwv_spot next unless $filter; } if ($dxchan->is_node) { - next if $dxchan == $self; if ($hops) { $routeit = $line; $routeit =~ s/\^H\d+\^\~$/\^H$hops\^\~/; @@ -1380,6 +1245,7 @@ sub send_wcy_spot # send it if it isn't the except list and isn't isolated and still has a hop count # taking into account filtering and so on foreach $dxchan (@dxchan) { + next if $dxchan == $me; my $routeit; my ($filter, $hops); @@ -1388,7 +1254,6 @@ sub send_wcy_spot next unless $filter; } if ($dxchan->is_clx || $dxchan->is_spider || $dxchan->is_dxnet) { - next if $dxchan == $self; if ($hops) { $routeit = $line; $routeit =~ s/\^H\d+\^\~$/\^H$hops\^\~/; @@ -1457,6 +1322,8 @@ sub send_announce # send it if it isn't the except list and isn't isolated and still has a hop count # taking into account filtering and so on foreach $dxchan (@dxchan) { + next if $dxchan == $self; + next if $dxchan == $me; my $routeit; my ($filter, $hops); @@ -1465,7 +1332,6 @@ sub send_announce next unless $filter; } if ($dxchan->is_node && $_[1] ne $main::mycall) { # i.e not specifically routed to me - next if $dxchan == $self; if ($hops) { $routeit = $line; $routeit =~ s/\^H\d+\^\~$/\^H$hops\^\~/; @@ -1501,39 +1367,28 @@ sub send_local_config my $self = shift; my $n; my @nodes; - my @localnodes; - my @remotenodes; + my @localcalls; + my @remotecalls; # send our nodes if ($self->{isolate}) { - @localnodes = (DXCluster->get_exact($main::mycall)); + @localcalls = ( $main::mycall ); } else { # create a list of all the nodes that are not connected to this connection # and are not themselves isolated, this to make sure that isolated nodes # don't appear outside of this node - @nodes = DXNode::get_all(); - @nodes = grep { $_->{call} ne $main::mycall } @nodes; - @nodes = grep { $_->dxchan != $self } @nodes if @nodes; - @nodes = grep { !$_->dxchan->{isolate} } @nodes if @nodes; - @localnodes = grep { $_->dxchan->{call} eq $_->{call} } @nodes if @nodes; - unshift @localnodes, DXCluster->get_exact($main::mycall); - @remotenodes = grep { $_->dxchan->{call} ne $_->{call} } @nodes if @nodes; - } - - my @s = $me->pc19(@localnodes, @remotenodes); - for (@s) { - my $routeit = adjust_hops($self, $_); - $self->send($routeit) if $routeit; + my @dxchan = grep { $_->call ne $main::mycall && $_->call ne $self->{call} && !$_->{isolate} } DXChannel::get_all_nodes(); + @localcalls = map { $_->{call} } @dxchan if @dxchan; + @remotecalls = map {my $r = Route::Node::get($_); $r ? $r->rnodes(@localcalls, $main::mycall, $self->{call}) : () } @localcalls if @localcalls; + unshift @localcalls, $main::mycall; } + @nodes = map {my $r = Route::Node::get($_); $r ? $r : ()} (@localcalls, @remotecalls); + + send_route($self, \&pc19, scalar @nodes, @nodes); # get all the users connected on the above nodes and send them out - foreach $n (@localnodes, @remotenodes) { - my @users = values %{$n->list}; - my @s = pc16($n, @users); - for (@s) { - my $routeit = adjust_hops($self, $_); - $self->send($routeit) if $routeit; - } + foreach $n (@nodes) { + send_route($self, \&pc16, 1, $n, map {my $r = Route::User::get($_); $r ? ($r) : ()} $n->users); } } @@ -1554,7 +1409,7 @@ sub route # always send it down the local interface if available my $dxchan = DXChannel->get($call); unless ($dxchan) { - my $cl = DXCluster->get_exact($call); + my $cl = Route::Node::get($call); $dxchan = $cl->dxchan if $cl; if (ref $dxchan) { if (ref $self && $dxchan eq $self) { @@ -1745,8 +1600,9 @@ sub addrcmd $r->{cmd} = $cmd; $rcmds{$to} = $r; - my $ref = DXCluster->get_exact($to); - if ($ref && $ref->dxchan && $ref->dxchan->is_clx) { + my $ref = Route::Node::get($to); + my $dxchan = $ref->dxchan; + if ($dxchan && $dxchan->is_clx) { route(undef, $to, pc84($main::mycall, $to, $self->{call}, $cmd)); } else { route(undef, $to, pc34($main::mycall, $to, $cmd)); @@ -1764,38 +1620,20 @@ sub disconnect } # do routing stuff - my $pref = Route::Node::get($self->{call}); - my @rout = $pref->del_nodes if $pref; - push @rout, $main::routeroot->del_node($call); +# my $node = Route::Node::get($self->{call}); +# my @rout = $node->del_nodes if $node; + my @rout = $main::routeroot->del_node($call); dbg('route', "B/C PC21 (from PC39) for: " . join(',', (map{ $_->call } @rout))) if @rout; # unbusy and stop and outgoing mail my $mref = DXMsg::get_busy($call); $mref->stop_msg($call) if $mref; - # create a list of all the nodes that have gone and delete them from the table - my @nodes; - foreach my $node (grep { $_->dxchancall eq $call } DXNode::get_all) { - next if $node->call eq $call; - next if $node->call eq $main::mycall; - push @nodes, $node->call; - $node->del; - } - # broadcast to all other nodes that all the nodes connected to via me are gone unless ($pc39flag && $pc39flag == 2) { - unless ($self->{isolate}) { - push @nodes, $call; - for (@nodes) { - broadcast_ak1a(pc21($_, 'Gone.'), $self); - } - } + $self->route_pc21(@rout) if @rout; } - # remove this node from the tables - my $node = DXCluster->get_exact($call); - $node->del if $node; - # remove outstanding pings delete $pings{$call}; @@ -1822,5 +1660,77 @@ sub talk $self->send(DXProt::pc10($from, $to, $via, $line)); Log('talk', $self->call, $from, $via?$via:$main::mycall, $line); } + +# send it if it isn't the except list and isn't isolated and still has a hop count +# taking into account filtering and so on +sub send_route +{ + my $self = shift; + my $generate = shift; + my $no = shift; # the no of things to filter on + my $routeit; + my ($filter, $hops); + my @rin; + + if ($self->{routefilter}) { + for (; @_ && $no; $no--) { + my $r = shift; + ($filter, $hops) = $self->{routefilter}->it($self->{call}, $self->{dxcc}, $self->{itu}, $self->{cq}, $r->call, $r->dxcc, $r->itu, $r->cq); + push @rin, $r if $filter; + } + } + if (@rin) { + foreach my $line (&$generate(@rin, @_)) { + if ($hops) { + $routeit = $line; + $routeit =~ s/\^H\d+\^\~$/\^H$hops\^\~/; + } else { + $routeit = adjust_hops($self, $line); # adjust its hop count by node name + next unless $routeit; + } + $self->send($routeit) unless $self->{isolate} || $self->{isolate}; + } + } +} + +sub broadcast_route +{ + my $self = shift; + my $generate = shift; + my @dxchan = DXChannel::get_all_nodes(); + my $dxchan; + my $line; + + foreach $dxchan (@dxchan) { + next if $dxchan == $self; + next if $dxchan == $me; + $dxchan->send_route($generate, @_); + } +} + +sub route_pc16 +{ + my $self = shift; + broadcast_route($self, \&pc16, 1, @_); +} + +sub route_pc17 +{ + my $self = shift; + broadcast_route($self, \&pc17, 1, @_); +} + +sub route_pc19 +{ + my $self = shift; + broadcast_route($self, \&pc19, scalar @_, @_); +} + +sub route_pc21 +{ + my $self = shift; + broadcast_route($self, \&pc21, scalar @_, @_); +} + 1; __END__ diff --git a/perl/DXProtout.pm b/perl/DXProtout.pm index 1ebb29bc..786d78c0 100644 --- a/perl/DXProtout.pm +++ b/perl/DXProtout.pm @@ -67,36 +67,42 @@ sub pc12 # # add one or more users (I am expecting references that have 'call', -# 'confmode' & 'here' method) +# 'conf' & 'here' method) # # this will create a list of PC16 with up pc16_max_users in each # called $self->pc16(..) # sub pc16 { - my $self = shift; + my $node = shift; + my $ncall = $node->call; my @out; - my $i; - for ($i = 0; @_; ) { - my $str = "PC16^$self->{call}"; - for ( ; @_ && length $str < 200; $i++) { + my $str = "PC16^$ncall"; + while (@_) { + for ( ; @_ && length $str < 200; ) { my $ref = shift; - $str .= sprintf "^%s %s %d", $ref->call, $ref->confmode ? '*' : '-', $ref->here; + $str .= sprintf "^%s %s %d", $ref->call, $ref->conf ? '*' : '-', $ref->here; } $str .= sprintf "^%s^", get_hops(16); push @out, $str; - $i = 0; } - return (@out); + return @out; } # remove a local user sub pc17 { - my ($self, $ref) = @_; - my $hops = get_hops(17); - return "PC17^$ref->{call}^$self->{call}^$hops^"; + my @out; + while (@_) { + my $node = shift; + my $ref = shift; + my $hops = get_hops(17); + my $ncall = $node->call; + my $ucall = $ref->call; + push @out, "PC17^$ucall^$ncall^$hops^"; + } + return @out; } # Request init string @@ -110,22 +116,20 @@ sub pc18 # sub pc19 { - my $self = shift; my @out; - my $i; - - for ($i = 0; @_; ) { + while(@_) { my $str = "PC19"; - for (; @_ && length $str < 200; $i++) { + for (; @_ && length $str < 200;) { my $ref = shift; - my $here = $ref->{here} ? '1' : '0'; - my $confmode = $ref->{confmode} ? '1' : '0'; - $str .= "^$here^$ref->{call}^$confmode^$ref->{pcversion}"; + my $call = $ref->call; + my $here = $ref->here; + my $conf = $ref->conf; + my $version = $ref->version; + $str .= "^$here^$call^$conf^$version"; } $str .= sprintf "^%s^", get_hops(19); push @out, $str; - $i = 0; } return @out; } @@ -139,10 +143,14 @@ sub pc20 # delete a node sub pc21 { - my ($call, $reason) = @_; - my $hops = get_hops(21); - $reason = "Gone." if !$reason; - return "PC21^$call^$reason^$hops^"; + my @out; + while (@_) { + my $node = shift; + my $hops = get_hops(21); + my $call = $node->call; + push @out, "PC21^$call^Gone^$hops^"; + } + return @out; } # end of init phase @@ -244,8 +252,7 @@ sub pc35 # send all the DX clusters I reckon are connected sub pc38 { - my @nodes = map { ($_->dxchan && $_->dxchan->isolate) ? () : $_->call } DXNode->get_all(); - return "PC38^" . join(',', @nodes) . "^~"; + return join '^', "PC38", map {$_->call} Route::Node::get_all(); } # tell the local node to discconnect diff --git a/perl/Route.pm b/perl/Route.pm index cbc172dd..f406a98a 100644 --- a/perl/Route.pm +++ b/perl/Route.pm @@ -15,23 +15,51 @@ package Route; use DXDebug; +use DXChannel; +use Prefix; use strict; -use vars qw(%list %valid); +use vars qw(%list %valid $filterdef); %valid = ( call => "0,Callsign", flags => "0,Flags,phex", + dxcc => '0,Country Code', + itu => '0,ITU Zone', + cq => '0,CQ Zone', ); +$filterdef = bless ([ + # tag, sort, field, priv, special parser + ['channel', 'c', 0], + ['channel_dxcc', 'n', 1], + ['channel_itu', 'n', 2], + ['channel_zone', 'n', 3], + ['call', 'c', 4], + ['call_dxcc', 'n', 5], + ['call_itu', 'n', 6], + ['call_zone', 'n', 7], + ], 'Filter::Cmd'); + + sub new { my ($pkg, $call) = @_; + $pkg = ref $pkg if ref $pkg; + + my $self = bless {call => $call}, $pkg; + dbg('routelow', "create $pkg with $call"); - dbg('routelow', "create " . (ref($pkg) || $pkg) ." with $call"); + # add in all the dxcc, itu, zone info + my @dxcc = Prefix::extract($call); + if (@dxcc > 0) { + $self->{dxcc} = $dxcc[1]->dxcc; + $self->{itu} = $dxcc[1]->itu; + $self->{cq} = $dxcc[1]->cq; + } - return bless {call => $call}, (ref $pkg || $pkg); + return $self; } # @@ -89,9 +117,9 @@ sub here my $self = shift; my $r = shift; return $self ? 2 : 0 unless ref $self; - return $self->{flags} & 2 unless $r; - $self->{flags} = (($self->{flags} & ~2) | ($r ? 2 : 0)); - return $r; + return ($self->{flags} & 2) ? 1 : 0 unless $r; + $self->{flags} = (($self->{flags} & ~2) | ($r ? 1 : 0)); + return $r ? 1 : 0; } sub conf @@ -99,9 +127,15 @@ sub conf my $self = shift; my $r = shift; return $self ? 1 : 0 unless ref $self; - return $self->{flags} & 1 unless $r; + return ($self->{flags} & 1) ? 1 : 0 unless $r; $self->{flags} = (($self->{flags} & ~1) | ($r ? 1 : 0)); - return $r; + return $r ? 1 : 0; +} + +sub parents +{ + my $self = shift; + return @{$self->{parent}}; } # @@ -149,7 +183,7 @@ sub config } else { $line =~ s/\s+$//; push @out, $line; - $line = ' ' x ($level*2) . "$call->"; + $line = ' ' x ($level*2) . "$call->$c "; } } } @@ -173,10 +207,66 @@ sub config return @out; } +sub cluster +{ + my $nodes = Route::Node::count(); + my $tot = Route::User::count(); + my $users = scalar DXCommandmode::get_all(); + my $maxusers = Route::User::max(); + my $uptime = main::uptime(); + + return " $nodes nodes, $users local / $tot total users Max users $maxusers Uptime $uptime"; +} + # # routing things # +sub get +{ + my $call = shift; + return Route::Node::get($call) || Route::User::get($call); +} + +# find all the possible dxchannels which this object might be on +sub alldxchan +{ + my $self = shift; + + my $dxchan = DXChannel->get($self->{call}); + if ($dxchan) { + return (grep $dxchan == $_, @_) ? () : ($dxchan); + } + + # it isn't, build up a list of dxchannels and possible ping times + # for all the candidates. + my @dxchan = @_; + foreach my $p (@{$self->{parent}}) { + my $ref = $self->get($p); + push @dxchan, $ref->alldxchan(@dxchan); + } + return @dxchan; +} + +sub dxchan +{ + my $self = shift; + my $dxchan; + my @dxchan = $self->alldxchan; + return undef unless @dxchan; + + # determine the minimum ping channel + my $minping = 99999999; + foreach my $dxc (@dxchan) { + my $p = $dxc->pingave; + if (defined $p && $p < $minping) { + $minping = $p; + $dxchan = $dxc; + } + } + $dxchan = shift @dxchan unless $dxchan; + return $dxchan; +} # # track destruction diff --git a/perl/Route/Node.pm b/perl/Route/Node.pm index 9e1f3c04..c7068204 100644 --- a/perl/Route/Node.pm +++ b/perl/Route/Node.pm @@ -14,22 +14,24 @@ use Route::User; use strict; -use vars qw(%list %valid @ISA $max); +use vars qw(%list %valid @ISA $max $filterdef); @ISA = qw(Route); %valid = ( parent => '0,Parent Calls,parray', nodes => '0,Nodes,parray', users => '0,Users,parray', + usercount => '0,User Count', version => '0,Version', ); +$filterdef = $Route::filterdef; %list = (); $max = 0; sub count { - my $n = scalar %list; + my $n = scalar (keys %list); $max = $n if $n > $max; return $n; } @@ -55,9 +57,11 @@ sub add { my $parent = shift; my $call = uc shift; + confess "Route::add trying to add $call to myself" if $call eq $parent->{call}; my $self = get($call); if ($self) { $self->_addparent($parent->{call}); + $parent->_addnode($call); return undef; } $parent->_addnode($call); @@ -87,8 +91,8 @@ sub del unless (@$ref) { push @nodes, $self->del_nodes; delete $list{$self->{call}}; + push @nodes, $self; } - push @nodes, $self; return @nodes; } @@ -116,15 +120,34 @@ sub del_nodes return @nodes; } +# delete a node from this node (ie I am a parent) +sub del_node +{ + my $self = shift; + my $ncall = shift; + my @out; + $self->_delnode($ncall); + if (my $ref = get($ncall)) { + foreach my $rcall (@{$ref->{nodes}}) { + next if $rcall eq $ncall || $rcall eq $self->{call}; + push @out, $ref->del_node($rcall); + } + push @out, $ref->del($self); + } + return @out; +} + # add a user to this node sub add_user { my $self = shift; my $ucall = shift; $self->_adduser($ucall); - + + $self->{usercount} = scalar @{$self->{users}}; my $uref = Route::User::get($ucall); - return $uref ? () : (Route::User->new($ucall, $self->{call}, @_)); + my @out = (Route::User->new($ucall, $self->{call}, @_)) unless $uref; + return @out; } # delete a user from this node @@ -134,21 +157,45 @@ sub del_user my $ucall = shift; my $ref = Route::User::get($ucall); $self->_deluser($ucall); - return ($ref->del($self)) if $ref; - return (); + my @out = $ref->del($self) if $ref; + return @out; } -# delete a node from this node (ie I am a parent) -sub del_node +sub usercount { my $self = shift; - my $ncall = shift; - $self->_delnode($ncall); - my $ref = get($ncall); - return ($ref->del($self)) if $ref; - return (); + if (@_ && @{$self->{users}} == 0) { + $self->{usercount} = shift; + } + return $self->{usercount}; } +sub users +{ + my $self = shift; + return @{$self->{users}}; +} + +sub nodes +{ + my $self = shift; + return @{$self->{nodes}}; +} + +sub rnodes +{ + my $self = shift; + my @out; + foreach my $call (@{$self->{nodes}}) { + next if grep $call eq $_, @_; + push @out, $call; + my $r = get($call); + push @out, $r->rnodes(@_, @out) if $r; + } + return @out; +} + + sub new { my $pkg = shift; @@ -175,6 +222,11 @@ sub get return $list{uc $call}; } +sub get_all +{ + return values %list; +} + sub _addparent { my $self = shift; diff --git a/perl/Route/User.pm b/perl/Route/User.pm index 4e3e59cf..adb2bbd1 100644 --- a/perl/Route/User.pm +++ b/perl/Route/User.pm @@ -13,19 +13,20 @@ use Route; use strict; -use vars qw(%list %valid @ISA $max); +use vars qw(%list %valid @ISA $max $filterdef); @ISA = qw(Route); %valid = ( parent => '0,Parent Calls,parray', ); +$filterdef = $Route::filterdef; %list = (); $max = 0; sub count { - my $n = scalar %list; + my $n = scalar(keys %list); $max = $n if $n > $max; return $n; } @@ -57,8 +58,8 @@ sub del my $pref = shift; my $ref = $self->delparent($pref->{call}); return () if @$ref; - delete $list{$self->{call}}; - return ($ref); + my @out = delete $list{$self->{call}}; + return @out; } sub get diff --git a/perl/cluster.pl b/perl/cluster.pl index 35881d45..fd23a253 100755 --- a/perl/cluster.pl +++ b/perl/cluster.pl @@ -61,7 +61,6 @@ use DXProtVars; use DXProtout; use DXProt; use DXMsg; -use DXCluster; use DXCron; use DXConnect; use DXBearing; @@ -145,24 +144,9 @@ sub new_channel return; } - # is there one already connected elsewhere in the cluster? if ($user) { - if (($user->is_node || $call eq $myalias) && !DXCluster->get_exact($call)) { - ; - } else { - if (my $ref = DXCluster->get_exact($call)) { - my $mess = DXM::msg($lang, 'concluster', $call, $ref->mynode->dxchancall); - already_conn($conn, $call, $mess); - return; - } - } $user->{lang} = $main::lang if !$user->{lang}; # to autoupdate old systems } else { - if (my $ref = DXCluster->get_exact($call)) { - my $mess = DXM::msg($lang, 'concluster', $call, $ref->mynode->dxchancall); - already_conn($conn, $call, $mess); - return; - } $user = DXUser->new($call); } @@ -437,8 +421,13 @@ dbg('err', "reading in duplicate spot and WWV info ..."); DXProt->init(); # put in a DXCluster node for us here so we can add users and take them away -DXNode->new($DXProt::me, $mycall, 0, 1, $DXProt::myprot_version); -$routeroot = Route::Node->new($mycall, $version, Route::here($DXProt::me->here)|Route::conf($DXProt::me->confmode)); +$routeroot = Route::Node->new($mycall, $version*100+5300, Route::here($DXProt::me->here)|Route::conf($DXProt::me->conf)); + +# make sure that there is a routing OUTPUT node default file +unless (Filter::read_in('route', 'node_default', 0)) { + my $dxcc = $DXProt::me->dxcc; + $Route::filterdef->cmd($DXProt::me, 'route', 'accept', "node_default call_dxcc $dxcc" ); +} # read in any existing message headers and clean out old crap dbg('err', "reading existing message headers ..."); -- 2.43.0