an AFAIK nominally working (for one connection) version

diff --git a/perl/DXChannel.pm b/perl/DXChannel.pm
index d0c995d9756c3bd582e3ed2c9db8766f6b38d5a0..829c6b55585bf0022e6f96c28a17be6d368d5798 100644 (file)
--- 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 7025f683d0e3bff188db490801c6a936d47fefac..8e5d789bdd5e36ae7e43a62dd52daa452db1c94a 100644 (file)
--- 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 04ef99cb8ecffccfb21d7215b590a886497d2a8d..a6bde3ed1b2838f5a7ad3b5a138d9ca041ce9f06 100644 (file)
--- 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 497a26712b63f64b279b7bde6992f4d4fc2d525b..0b788ba73c10d0ed68818b09c7c3b1d2ae6290ed 100644 (file)
--- 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 45bd7213e147eceb93bf3458f294b2dbd0b67a1c..7858e16ce7500dcce1864b07e2ba4f857cd1cd77 100644 (file)
--- 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 3c0feb4ba32f527fedd97b7321fbb13757fe6840..83f5768c0e6fe8fa5df2fae2eab16cdeffc61f84 100644 (file)
--- 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 b8d5fb3633ad3155ae0952e7ffc78f720998800b..7c71640e17cd85090a998ef7d81d65993a47be50 100644 (file)
--- 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;