+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
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;
}
} 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);
}
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);
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];
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;
# 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
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);
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;
$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) {
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++;
}
#
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;
$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;
['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');
use DXVars;
use DXDebug;
use Filter;
+use Prefix;
use strict;
use vars qw(%channels %valid @ISA $count);
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',
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',
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
$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;
$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;
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);
# 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;
}
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
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);
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(\@_); };
);
}
use DXChannel;
use DXUser;
use DXM;
-use DXCluster;
use DXProtVars;
use DXProtout;
use DXDebug;
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;
use DXChannel;
use DXUser;
use DXM;
-use DXCluster;
use DXProtVars;
use DXCommandmode;
use DXLog;
$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)
$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");
# 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");
}
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));
# 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;
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
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
# 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;
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
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!");
}
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) {
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;
}
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};
}
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;
}
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};
#
# 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
{
# 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);
# 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);
next unless $filter;
}
if ($dxchan->is_node) {
- next if $dxchan == $self;
if ($hops) {
$routeit = $line;
$routeit =~ s/\^H\d+\^\~$/\^H$hops\^\~/;
# 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);
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\^\~/;
# 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);
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\^\~/;
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);
}
}
# 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) {
$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));
}
# 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};
$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__
#
# 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
#
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;
}
# 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
# 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
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;
}
#
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
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}};
}
#
} else {
$line =~ s/\s+$//;
push @out, $line;
- $line = ' ' x ($level*2) . "$call->";
+ $line = ' ' x ($level*2) . "$call->$c ";
}
}
}
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
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;
}
{
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);
unless (@$ref) {
push @nodes, $self->del_nodes;
delete $list{$self->{call}};
+ push @nodes, $self;
}
- push @nodes, $self;
return @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
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;
return $list{uc $call};
}
+sub get_all
+{
+ return values %list;
+}
+
sub _addparent
{
my $self = shift;
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;
}
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
use DXProtout;
use DXProt;
use DXMsg;
-use DXCluster;
use DXCron;
use DXConnect;
use DXBearing;
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);
}
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 ...");