From ebbf88f53284e6b7e77c3319047607b1c5cd2518 Mon Sep 17 00:00:00 2001 From: minima Date: Wed, 7 Jul 2004 13:54:52 +0000 Subject: [PATCH] an AFAIK nominally working (for one connection) version --- perl/DXChannel.pm | 4 +-- perl/DXCommandmode.pm | 4 +-- perl/DXMsg.pm | 2 +- perl/DXProt.pm | 62 ++++++++++++++++++++++++++----------------- perl/Route.pm | 33 ++++++++++++++++------- perl/Route/Node.pm | 16 ++++++----- perl/Route/User.pm | 3 ++- 7 files changed, 79 insertions(+), 45 deletions(-) diff --git a/perl/DXChannel.pm b/perl/DXChannel.pm index d0c995d9..829c6b55 100644 --- a/perl/DXChannel.pm +++ b/perl/DXChannel.pm @@ -524,7 +524,7 @@ sub rspfcheck { my ($self, $flag, $node, $user) = @_; my $nref = Route::Node::get($node); - my $dxchan = $nref->dxchan if $nref; + my $dxchan = $nref->bestdxchan if $nref; if ($nref && $dxchan) { if ($dxchan == $self) { return 1 unless $user; @@ -533,7 +533,7 @@ sub rspfcheck return 1 if @users == 0 || grep $user eq $_, @users; dbg("RSPF: $user not on $node") if isdbg('chanerr'); } else { - dbg("RSPF: Shortest path for $node is " . $nref->dxchan->{call}) if isdbg('chanerr'); + dbg("RSPF: Shortest path for $node is " . $nref->bestdxchan->{call}) if isdbg('chanerr'); } } else { return 1 if $flag; diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm index 7025f683..8e5d789b 100644 --- a/perl/DXCommandmode.pm +++ b/perl/DXCommandmode.pm @@ -348,7 +348,7 @@ sub send_talks $to = $ent unless $to; my $call = $via ? $via : $to; my $clref = Route::get($call); - my $dxchan = $clref->dxchan if $clref; + my $dxchan = $clref->bestdxchan if $clref; if ($dxchan) { $dxchan->talk($self->{call}, $to, $via, $line); } else { @@ -765,7 +765,7 @@ sub talk my $key = "$to$from"; unless (exists $nothereslug{$key}) { my ($ref, $dxchan); - if (($ref = Route::get($from)) && ($dxchan = $ref->dxchan)) { + if (($ref = Route::get($from)) && ($dxchan = $ref->bestdxchan)) { my $name = $self->user->name || $to; my $s = $self->user->nothere || $dxchan->msg('nothere', $name); $nothereslug{$key} = $main::systime; diff --git a/perl/DXMsg.pm b/perl/DXMsg.pm index 04ef99cb..a6bde3ed 100644 --- a/perl/DXMsg.pm +++ b/perl/DXMsg.pm @@ -774,7 +774,7 @@ sub queue_msg next if $ref->{'read'}; # if it is read, it is stuck here $clref = Route::get($ref->{to}); if ($clref) { - $dxchan = $clref->dxchan; + $dxchan = $clref->bestdxchan; if ($dxchan) { if ($dxchan->is_node) { next if $clref->call eq $main::mycall; # i.e. it lives here diff --git a/perl/DXProt.pm b/perl/DXProt.pm index 497a2671..0b788ba7 100644 --- a/perl/DXProt.pm +++ b/perl/DXProt.pm @@ -444,7 +444,7 @@ sub handle_10 if ($ref = Route::get($to)) { $vref = Route::Node::get($via) if $via; $vref = undef unless $vref && grep $to eq $_, $vref->users; - $ref->dxchan->talk($from, $to, $vref ? $via : undef, $_[3], $_[6]); + $ref->bestdxchan->talk($from, $to, $vref ? $via : undef, $_[3], $_[6]); return; } @@ -453,7 +453,7 @@ sub handle_10 $ref = Route::get($from); $vref = $ref = Route::Node::get($_[6]) unless $ref; if ($ref) { - $dxchan = $ref->dxchan; + $dxchan = $ref->bestdxchan; $dxchan->talk($main::mycall, $from, $vref ? $vref->call : undef, $dxchan->msg('talknh', $to) ); } } @@ -572,7 +572,7 @@ sub handle_11 if ($send_opernam && $to && $to ne $main::mycall && $main::systime > $last + $DXUser::lastoperinterval && ($node = Route::Node::get($to)) ) { my $cmd = "forward/opernam $spot[4]"; # send the rcmd but we aren't interested in the replies... - my $dxchan = $node->dxchan; + my $dxchan = $node->bestdxchan; if ($dxchan && $dxchan->is_clx) { route(undef, $to, pc84($main::mycall, $to, $main::mycall, $cmd)); } else { @@ -582,7 +582,7 @@ sub handle_11 $to = $_[7]; $node = Route::Node::get($to); if ($node) { - $dxchan = $node->dxchan; + $dxchan = $node->bestdxchan; if ($dxchan && $dxchan->is_clx) { route(undef, $to, pc84($main::mycall, $to, $main::mycall, $cmd)); } else { @@ -666,7 +666,7 @@ sub handle_12 if ($call) { my $ref = Route::get($call); if ($ref) { - $dxchan = $ref->dxchan; + $dxchan = $ref->bestdxchan; $dxchan->talk($_[1], $call, undef, $_[3], $_[5]) if $dxchan != $self; return; } @@ -707,7 +707,10 @@ sub handle_16 } # do we believe this call? - next unless $ncall eq $self->{call} || $self->is_believed($ncall); + unless ($ncall eq $self->{call} || $self->is_believed($ncall)) { + dbg("PCPROT: We don't believe $ncall on $self->{call}"); + return; + } my $node = Route::Node::get($ncall); unless ($node) { @@ -740,8 +743,8 @@ sub handle_16 dbg("PCPROT: $call is a node") if isdbg('chanerr'); next; } - - $r = Route::User::get($call) || Route::User::get($call); + + $r = Route::User::get($call) || Route::User->new($call); $r->here($here); $r->conf($conf); $node->lastseen($main::systime); @@ -784,7 +787,10 @@ sub handle_17 } # do we believe this call? - next unless $ncall eq $self->{call} || $self->is_believed($ncall); + unless ($ncall eq $self->{call} || $self->is_believed($ncall)) { + dbg("PCPROT: We don't believe $ncall on $self->{call}"); + return; + } my $uref = Route::User::get($ucall); unless ($uref) { @@ -843,11 +849,15 @@ sub handle_18 # first clear out any nodes on this dxchannel my $node = Route::Node::get($self->{call}) ; - my @rout = grep {$_ != $node } $main::routeroot->remove_route($node, $self) if $node; - my @rusers; - push @rusers, $_->unlink_all_users for @rout; + my @rout; + foreach my $n ($node->nodes) { + next if $n eq $main::mycall; + next if $n eq $self->{call}; + my $nref = Route::Node::get($n); + push @rout, $node->remove_route($nref, $self) if $nref; + } $self->route_pc21($origin, $line, @rout) if @rout; - for (@rout, @rusers) { + for (@rout) { $_->delete; }; @@ -900,7 +910,10 @@ sub handle_19 next if $call eq $main::mycall; # do we believe this call? - next unless $call eq $self->{call} || $self->is_believed($call); + unless ($call eq $self->{call} || $self->is_believed($call)) { + dbg("PCPROT: We don't believe $call on $self->{call}"); + next; + } eph_del_regex("^PC(?:21\\^$call|17\\^[^\\^]+\\^$call)"); @@ -964,6 +977,11 @@ sub handle_21 return if $call eq $main::mycall; # don't allow malicious buggers to disconnect me (or ignore loops)! + unless ($call eq $self->{call} || $self->is_believed($call)) { + dbg("PCPROT: We don't believe $call on $self->{call}"); + return; + } + eph_del_regex("^PC1[679].*$call"); # if I get a PC21 from the same callsign as self then treat it @@ -1425,7 +1443,7 @@ sub handle_59 return unless $self->in_filter_route($fnode); # now do it properly for actions - my $node = Route::Node::get($ncall) || Route::Node::new($ncall); + my $node = Route::Node::get($ncall) || Route::Node->new($ncall); $node->newroute(1); # find each of the entries (or create new ones) @@ -1456,7 +1474,7 @@ sub handle_59 $user->node($ncall); $user->put; } - $ref = Route::User::new($ecall, 0); + $ref = Route::User->new($ecall, 0); } } elsif ($esort eq 'N') { $ref = Route::Node::get($ecall); @@ -1472,7 +1490,7 @@ sub handle_59 $user->node($ncall); $user->put; } - $ref = Route::Node::new($ecall, 0); + $ref = Route::Node->new($ecall, 0); } } else { dbg("DXPROT: unknown entity type '$esort' on $ecall for node $ncall") if isdbg('chan'); @@ -2041,7 +2059,7 @@ sub route my $dxchan = DXChannel->get($call); unless ($dxchan) { my $cl = Route::get($call); - $dxchan = $cl->dxchan if $cl; + $dxchan = $cl->bestdxchan if $cl; if (ref $dxchan) { if (ref $self && $dxchan eq $self) { dbg("PCPROT: Trying to route back to source, dropped") if isdbg('chanerr'); @@ -2217,7 +2235,7 @@ sub addrcmd $rcmds{$to} = $r; my $ref = Route::Node::get($to); - my $dxchan = $ref->dxchan; + my $dxchan = $ref->bestdxchan; if ($dxchan && $dxchan->is_clx) { route(undef, $to, pc84($main::mycall, $to, $self->{call}, $cmd)); } else { @@ -2243,16 +2261,12 @@ sub disconnect # do routing stuff, remove me from routing table my $node = Route::Node::get($call); my @rout; - my @rusers; if ($node) { # remove the route from this node and return a list # of nodes that have become orphanned as a result. push @rout, $main::routeroot->remove_route($node, $self); - # remove all consequently orphanned users from these nodes - push @rusers, $_->unlink_all_users for @rout; - # remove all my ephemera as well for (@rout) { my $c = $_->call; @@ -2271,7 +2285,7 @@ sub disconnect } # delete all the unwanted nodes - $_->delete for @rout, @rusers; + $_->delete for @rout; # remove outstanding pings delete $pings{$call}; diff --git a/perl/Route.pm b/perl/Route.pm index 45bd7213..7858e16c 100644 --- a/perl/Route.pm +++ b/perl/Route.pm @@ -37,7 +37,7 @@ use vars qw(%list %valid $filterdef); cq => '0,CQ Zone', state => '0,State', city => '0,City', - lastseen => 'Last Seen,atime', + lastseen => '0,Last Seen,atime', ); $filterdef = bless ([ @@ -201,8 +201,8 @@ sub config # recursion detector if ((DXChannel->get($self->{call}) && $level > 1) || grep $self->{call} eq $_, @$seen) { - $line .= ' ...'; - push @out, $line; +# $line .= ' ...'; +# push @out, $line; return @out; } push @$seen, $self->{call}; @@ -271,20 +271,35 @@ sub get return Route::Node::get($call) || Route::User::get($call); } +sub get_all +{ + return (Route::Node::get_all(), Route::User::get_all()); +} + # find all the possible dxchannels which this object might be on sub alldxchan { my $self = shift; - my @dxchan; -# dbg("Trying node $self->{call}") if isdbg('routech'); my $dxchan = DXChannel->get($self->{call}); - push @dxchan, $dxchan if $dxchan; + if ($dxchan) { + dbg("alldxchan for $self->{call} = $dxchan->{call}") if isdbg('routelow'); + return $dxchan if $dxchan; + } + + my @nodes; + if ($self->isa('Route::User')) { + push @nodes, map{Route::Node::get($_)} @{$self->{nodes}}; + } elsif ($self->isa('Route::Node')) { + push @nodes, $self; + } # it isn't, build up a list of dxchannels and possible ping times # for all the candidates. - unless (@dxchan) { - foreach my $p (@{$self->{dxchan}}) { + my @dxchan; + foreach my $nref (@nodes) { + next unless $nref; + foreach my $p (@{$nref->{dxchan}}) { # dbg("Trying dxchan $p") if isdbg('routech'); next if $p eq $main::mycall; # the root my $dxchan = DXChannel->get($p); @@ -298,7 +313,7 @@ sub alldxchan } } } -# dbg('routech', "Got dxchan: " . join(',', (map{ $_->call } @dxchan)) ); + dbg("alldxchan for $self->{call} = (" . join(',', @dxchan) . ")") if isdbg('routelow'); return @dxchan; } diff --git a/perl/Route/Node.pm b/perl/Route/Node.pm index 3c0feb4b..83f5768c 100644 --- a/perl/Route/Node.pm +++ b/perl/Route/Node.pm @@ -25,8 +25,8 @@ use vars qw(%list %valid @ISA $max $filterdef); %valid = ( dxchan => '0,DXChannel List,parray', - nodes => '0,Nodes,parray', - users => '0,Users,parray', + nodes => '0,Node List,parray', + users => '0,User List,parray', usercount => '0,User Count', version => '0,Version', newroute => '0,New Routing?,yesno', @@ -97,9 +97,9 @@ sub remove_route foreach my $r (@in) { next unless $r; next if $visited{$r->call}; - my ($o) = $r->del_dxchan($self); + my ($o) = $r->del_dxchan($dxchan); if ($o) { - dbg("Orphanning $_->{call}") if isdbg('routelow'); + dbg("Orphanning $o->{call}") if isdbg('routelow'); push @rout, $o; } push @in, map{ Route::Node::get($_) } $r->nodes; @@ -155,7 +155,8 @@ sub add_dxchan sub del_dxchan { my ($self, $dxchan) = @_; - return $self->_dellist('dxchan', $dxchan); + $self->_dellist('dxchan', $dxchan); + return $self->is_empty('dxchan') ? ($self) : (); } sub usercount @@ -213,7 +214,10 @@ sub new sub delete { my $self = shift; - dbg("deleting Route::Node $self->{call}") if isdbg('routelow'); + dbg("Deleting Route::Node $self->{call}") if isdbg('routelow'); + for ($self->unlink_all_users) { + $_->delete; + } delete $list{$self->{call}}; } diff --git a/perl/Route/User.pm b/perl/Route/User.pm index b8d5fb36..7c71640e 100644 --- a/perl/Route/User.pm +++ b/perl/Route/User.pm @@ -23,7 +23,8 @@ use vars qw(%list %valid @ISA $max $filterdef); @ISA = qw(Route); %valid = ( - dxchan => '0,Dxchan Calls,parray', + dxchan => '0,Dxchan List,parray', + nodes => '0,On Node(s),parray', ); $filterdef = $Route::filterdef; -- 2.43.0