X-Git-Url: http://www.dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXProt.pm;h=48fad54a02b48f5a35d23c0cfdf99f4a147be6f0;hb=6896890cedfefd163cec63c5dcde207e28c87472;hp=5028e2f93d049fad78f22f958364d7f62b347f7e;hpb=ab10b5e76b152d41273281b30b019e4c82ed22d8;p=spider.git

diff --git a/perl/DXProt.pm b/perl/DXProt.pm
index 5028e2f9..48fad54a 100644
--- a/perl/DXProt.pm
+++ b/perl/DXProt.pm
@@ -304,36 +304,17 @@ sub sendinit
 sub removepc90
 {
 	$_[0] =~ s/^PC90\^[-A-Z0-9]+\^\d+\^//;
+	$_[0] =~ s/^PC91\^[-A-Z0-9]+\^\d+\^[-A-Z0-9]+\^//;
 }
 
-sub send
-{
-	my $self = shift;
-	my $line = shift;
-	if ($self->user->wantpc90) {
-		$line = mungepc90($line);
-	} else {
-		removepc90($line);
-	}
-	$self->SUPER::send($line);
-}
-
-my $pc90msgid = 0;
-
-sub nextpc90
-{
-	$pc90msgid = 0 if $pc90msgid > 9999;
-	return $pc90msgid++;
-}
-
-sub mungepc90
-{
-	unless ($_[0] =~ /^PC90/) {
-		my $id = nextpc90();
-		return "PC90^$main::mycall^$id^" . $_[0]; 
-	} 
-	return $_[0];
-}
+#sub send
+#{
+#	my $self = shift;
+#	while (@_) {
+#		my $line = shift;
+#		$self->SUPER::send($line);
+#	}
+#}
 
 #
 # This is the normal pcxx despatcher
@@ -341,6 +322,10 @@ sub mungepc90
 sub normal
 {
 	my ($self, $line) = @_;
+
+	# remove any incoming PC90 frames
+	removepc90($line);
+
 	my @field = split /\^/, $line;
 	return unless @field;
 	
@@ -351,8 +336,10 @@ sub normal
 	
 	# process PC frames, this will fail unless the frame starts PCnn
 	my ($pcno) = $field[0] =~ /^PC(\d\d)/; # just get the number
-	return unless $pcno;
-	return if $pcno < 10 || $pcno > 99;
+	unless (defined $pcno && $pcno >= 10 && $pcno <= 99) {
+		dbg("PCPROT: unknown protocol") if isdbg('chanerr');
+		return;
+	}
 
 	# check for and dump bad protocol messages
 	my $n = check($pcno, @field);
@@ -361,72 +348,10 @@ sub normal
 		return;
 	}
 
-	# handle PC90 frames in a special way.
-    # 
-	# PC90 frames are normal frames that that are wrapped in inside a PC90 
-    # The extra fields are "originating node" and a sequence number.
-    # The sequence number is checked against the nodes 'last one' to see if
-	# it is a duplicate and, if so, is dropped at this stage; before any
-	# other processing.
-	#
-	# This is done here simply for efficiency. Adding another function would
-	# add more copying and so on.
-	#
-
-	my $origin = $self->call;
-	
-	if ($pcno >= 90) {
-		$origin = $field[1];
-		if ($origin eq $main::mycall) {
-			dbg("PCPROT: loop dupe") if isdbg('chanerr');
-			return;
-		}
-		my $seq = $field[2];
-		my $node = Route::Node::get($origin);
-		if ($node) {
-			if (my $lid = $node->lid) {
-				my $cmp = $seq >= $lid ? $seq : $seq + 9999;
-				if ($cmp <= $lid) {
-					dbg("PCPROT: sequence dupe $seq ($cmp) <= $lid") if isdbg('chanerr');
-					return;
-				}
-			}
-			$node->lid($seq);
-		}
-
-		# do a recheck on the contents of the PC90
-		if ($pcno == 90) {
-			shift @field;
-			shift @field;
-			shift @field;
-			
-			($pcno) = $field[0] =~ /^PC(\d\d)/; # just get the number
-			return unless $pcno;
-			return if $pcno < 10 || $pcno > 99;
-			
-			# check for and dump bad protocol messages
-			my $n = check($pcno, @field);
-			if ($n) {
-				dbg("PCPROT: bad field $n, dumped (" . parray($checklist[$pcno-10]) . ")") if isdbg('chanerr');
-				return;
-			}
-		}
-	}
-
-	# local processing 1
-	my $pcr;
-	eval {
-		$pcr = Local::pcprot($self, $pcno, @field);
-	};
-#	dbg("Local::pcprot error $@") if isdbg('local') if $@;
-	return if $pcr;
-
+	my $origin = $self->{call};
 	no strict 'subs';
 	my $sub = "handle_$pcno";
 
-	# add missing PC90 if not present (for ongoing distribution)
-	$line = mungepc90($line) if $pcno < 90;
-
 	if ($self->can($sub)) {
 		$self->$sub($pcno, $line, $origin, @field);
 	} else {
@@ -809,7 +734,7 @@ sub handle_16
 					$user->put;
 						
 					# route the pc19 - this will cause 'stuttering PC19s' for a while
-					$self->route_pc19(@nrout) if @nrout ;
+					$self->route_pc19($origin, $line, @nrout) if @nrout ;
 					$parent = Route::Node::get($ncall);
 					unless ($parent) {
 						dbg("PCPROT: lost $ncall after sending PC19 for it?");
@@ -879,8 +804,7 @@ sub handle_16
 		$user->lastin($main::systime) unless DXChannel->get($call);
 		$user->put;
 	}
-			
-	$self->route_pc16($parent, @rout) if @rout;
+	$self->route_pc16($origin, $line, $parent, @rout) if @rout;
 }
 		
 # remove a user
@@ -933,7 +857,7 @@ sub handle_17
 		return;
 	}
 
-	$self->route_pc17($parent, $uref);
+	$self->route_pc17($origin, $line, $parent, $uref);
 }
 		
 # link request
@@ -965,7 +889,7 @@ sub handle_18
 	# first clear out any nodes on this dxchannel
 	my $parent = Route::Node::get($self->{call});
 	my @rout = $parent->del_nodes;
-	$self->route_pc21(@rout, $parent) if @rout;
+	$self->route_pc21($origin, $line, @rout, $parent) if @rout;
 	$self->send_local_config();
 	$self->send(pc20());
 }
@@ -988,6 +912,8 @@ sub handle_19
 
 	# new routing list
 	my @rout;
+
+	# first get the INTERFACE node
 	my $parent = Route::Node::get($self->{call});
 	unless ($parent) {
 		dbg("DXPROT: my parent $self->{call} has disappeared");
@@ -995,6 +921,26 @@ sub handle_19
 		return;
 	}
 
+	# if the origin isn't the same as the INTERFACE, then reparent, creating nodes as necessary
+	if ($origin ne $self->call) {
+		my $op = Route::Node::get($origin);
+		unless ($op) {
+			$op = $parent->add($origin, 5000, Route::here(1));
+			my $user = DXUser->get_current($origin);
+			if (!$user) {
+				$user = DXUser->new($origin);
+				$user->sort('S');
+				$user->priv(1);		# I have relented and defaulted nodes
+				$user->lockout(1);
+				$user->homenode($origin);
+				$user->node($origin);
+				$user->wantroutepc19(1);
+			}
+			$user->put;
+		}
+		$parent = $op;
+	}
+
 	# parse the PC19
 	for ($i = 1; $i < $#_-1; $i += 4) {
 		my $here = $_[$i];
@@ -1076,7 +1022,7 @@ sub handle_19
 	}
 
 
-	$self->route_pc19(@rout) if @rout;
+	$self->route_pc19($origin, $line, @rout) if @rout;
 }
 		
 # send local configuration
@@ -1146,7 +1092,7 @@ sub handle_21
 		}
 	}
 
-	$self->route_pc21(@rout) if @rout;
+	$self->route_pc21($origin, $line, @rout) if @rout;
 }
 		
 
@@ -1234,7 +1180,7 @@ sub handle_24
 	my $ref = $nref || $uref;
 	return unless $self->in_filter_route($ref);
 
-	$self->route_pc24($ref, $_[3]);
+	$self->route_pc24($origin, $line, $ref, $_[3]);
 }
 		
 # merge request
@@ -1332,7 +1278,13 @@ sub handle_37
 	my $pcno = shift;
 	my $line = shift;
 	my $origin = shift;
-	DXDb::process($self, $line);
+	if ($_[1] eq $main::mycall) {
+		no strict 'refs';
+		my $sub = "DXDb::handle_$pcno";
+		&$sub($self, @_);
+	} else {
+		$self->route($_[1], $line) unless $self->is_clx;
+	}
 }
 
 # node connected list from neighbour
@@ -1474,7 +1426,7 @@ sub handle_50
 		# input filter if required
 		return unless $self->in_filter_route($node);
 
-		$self->route_pc50($node, $_[2], $_[3]) unless eph_dup($line);
+		$self->route_pc50($origin, $line, $node, $_[2], $_[3]) unless eph_dup($line);
 	}
 }
 		
@@ -1773,7 +1725,6 @@ sub send_wwv_spot
 
 		$dxchan->wwv($line, $self->{isolate}, @_, $self->{call}, $wwv_dxcc, $wwv_itu, $wwv_cq, $org_dxcc, $org_itu, $org_cq);
 	}
-	
 }
 
 sub wwv
@@ -2021,29 +1972,36 @@ sub send_local_config
 	# send our nodes
 	if ($self->{isolate}) {
 		@localnodes = ( $main::routeroot );
+		$self->send_route($main::mycall, \&pc19, 1, $main::routeroot);
 	} 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
+
+		# send locally connected nodes
 		my @dxchan = grep { $_->call ne $main::mycall && $_ != $self && !$_->{isolate} } DXChannel::get_all_nodes();
 		@localnodes = map { my $r = Route::Node::get($_->{call}); $r ? $r : () } @dxchan if @dxchan;
-		my @intcalls = map { $_->nodes } @localnodes if @localnodes;
+		$self->send_route($main::mycall, \&pc19, scalar(@localnodes)+1, $main::routeroot, @localnodes);
+
+		my $node;
+		my @rawintcalls = map { $_->nodes } @localnodes if @localnodes;
+		my @intcalls;
+		for $node (@rawintcalls) {
+			push @intcalls, $node unless grep $node eq $_, @intcalls; 
+		}
 		my $ref = Route::Node::get($self->{call});
 		my @rnodes = $ref->nodes;
-		for my $node (@intcalls) {
-			push @remotenodes, Route::Node::get($node) unless grep $node eq $_, @rnodes;
+		for $node (@intcalls) {
+			push @remotenodes, Route::Node::get($node) unless grep $node eq $_, @rnodes, @remotenodes;
 		}
-		unshift @localnodes, $main::routeroot;
+		$self->send_route($main::mycall, \&pc19, scalar(@remotenodes), @remotenodes);
 	}
 	
-
-	$self->send_route(\&pc19, scalar(@localnodes)+scalar(@remotenodes), @localnodes, @remotenodes);
-	
 	# get all the users connected on the above nodes and send them out
-	foreach $node (@localnodes, @remotenodes) {
+	foreach $node ($main::routeroot, @localnodes, @remotenodes) {
 		if ($node) {
 			my @rout = map {my $r = Route::User::get($_); $r ? ($r) : ()} $node->users;
-			$self->send_route(\&pc16, 1, $node, @rout) if @rout && $self->user->wantsendpc16;
+			$self->send_route($main::mycall, \&pc16, 1, $node, @rout) if @rout && $self->user->wantsendpc16;
 		} else {
 			dbg("sent a null value") if isdbg('chanerr');
 		}
@@ -2299,7 +2257,7 @@ sub disconnect
 	
 	# broadcast to all other nodes that all the nodes connected to via me are gone
 	unless ($pc39flag && $pc39flag == 2) {
-		$self->route_pc21(@rout) if @rout;
+		$self->route_pc21($main::mycall, undef, @rout) if @rout;
 	}
 
 	# remove outstanding pings
@@ -2331,9 +2289,11 @@ sub talk
 
 # 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 $origin = shift;
 	my $generate = shift;
 	my $no = shift;     # the no of things to filter on 
 	my $routeit;
@@ -2368,6 +2328,7 @@ sub send_route
 				$routeit = adjust_hops($self, $line);  # adjust its hop count by node name
 				next unless $routeit;
 			}
+			
 			$self->send($routeit);
 		}
 	}
@@ -2376,10 +2337,11 @@ sub send_route
 sub broadcast_route
 {
 	my $self = shift;
+	my $origin = shift;
 	my $generate = shift;
+	my $line = shift;
 	my @dxchan = DXChannel::get_all_nodes();
 	my $dxchan;
-	my $line;
 	
 	unless ($self->{isolate}) {
 		foreach $dxchan (@dxchan) {
@@ -2388,7 +2350,7 @@ sub broadcast_route
 			next unless $dxchan->isa('DXProt');
 			next if ($generate == \&pc16 || $generate==\&pc17) && !$dxchan->user->wantsendpc16;
  
-			$dxchan->send_route($generate, @_);
+			$dxchan->send_route($origin, $generate, @_);
 		}
 	}
 }
@@ -2397,44 +2359,58 @@ sub route_pc16
 {
 	my $self = shift;
 	return unless $self->user->wantpc16;
-	broadcast_route($self, \&pc16, 1, @_);
+	my $origin = shift;
+	my $line = shift;
+	broadcast_route($self, $origin, \&pc16, $line, 1, @_);
 }
 
 sub route_pc17
 {
 	my $self = shift;
 	return unless $self->user->wantpc16;
-	broadcast_route($self, \&pc17, 1, @_);
+	my $origin = shift;
+	my $line = shift;
+	broadcast_route($self, $origin, \&pc17, $line, 1, @_);
 }
 
 sub route_pc19
 {
 	my $self = shift;
-	broadcast_route($self, \&pc19, scalar @_, @_);
+	my $origin = shift;
+	my $line = shift;
+	broadcast_route($self, $origin, \&pc19, $line, scalar @_, @_);
 }
 
 sub route_pc21
 {
 	my $self = shift;
-	broadcast_route($self, \&pc21, scalar @_, @_);
+	my $origin = shift;
+	my $line = shift;
+	broadcast_route($self, $origin, \&pc21, $line, scalar @_, @_);
 }
 
 sub route_pc24
 {
 	my $self = shift;
-	broadcast_route($self, \&pc24, 1, @_);
+	my $origin = shift;
+	my $line = shift;
+	broadcast_route($self, $origin, \&pc24, $line, 1, @_);
 }
 
 sub route_pc41
 {
 	my $self = shift;
-	broadcast_route($self, \&pc41, 1, @_);
+	my $origin = shift;
+	my $line = shift;
+	broadcast_route($self, $origin, \&pc41, $line, 1, @_);
 }
 
 sub route_pc50
 {
 	my $self = shift;
-	broadcast_route($self, \&pc50, 1, @_);
+	my $origin = shift;
+	my $line = shift;
+	broadcast_route($self, $origin, \&pc50, $line, 1, @_);
 }
 
 sub in_filter_route
@@ -2458,7 +2434,6 @@ sub eph_dup
 
 	# chop the end off
 	$s =~ s/\^H\d\d?\^?\~?$//;
-	removepc90($s);
 	$r = 1 if exists $eph{$s};    # pump up the dup if it keeps circulating
 	$eph{$s} = $main::systime + $t;
 	return $r;