From: minima <minima>
Date: Wed, 7 Jul 2004 13:54:52 +0000 (+0000)
Subject: an AFAIK nominally working (for one connection) version
X-Git-Url: http://gb7djk.dxcluster.net/gitweb/gitweb.cgi?a=commitdiff_plain;h=ebbf88f53284e6b7e77c3319047607b1c5cd2518;p=spider.git

an AFAIK nominally working (for one connection) version
---

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;