X-Git-Url: http://www.dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXProt.pm;h=cbd0ff65a92480a839db78234bea83929e800903;hb=6ac34274be29c64e3f292622881f7af60009bc5d;hp=a3049ee329e502b416de681a37129a595b7d5136;hpb=f47bc72134852f42fe03ab6afe91a9ba1b0ff705;p=spider.git

diff --git a/perl/DXProt.pm b/perl/DXProt.pm
index a3049ee3..cbd0ff65 100644
--- a/perl/DXProt.pm
+++ b/perl/DXProt.pm
@@ -74,48 +74,48 @@ $chatdupeage = 20 * 60 * 60;
 
 @checklist = 
 (
- [ qw(c c m bp bc c) ],			# pc10
- [ qw(f m d t m c c h) ],		# pc11
- [ qw(c bm m bm bm p h) ],		# pc12
- [ qw(c h) ],					# 
- [ qw(c h) ],					# 
- [ qw(c m h) ],					# 
+ [ qw(i c c m bp bc c) ],			# pc10
+ [ qw(i f m d t m c c h) ],		# pc11
+ [ qw(i c bm m bm bm p h) ],		# pc12
+ [ qw(i c h) ],					# 
+ [ qw(i c h) ],					# 
+ [ qw(i c m h) ],					# 
  undef ,						# pc16 has to be validated manually
- [ qw(c c h) ],					# pc17
- [ qw(m n) ],					# pc18
+ [ qw(i c c h) ],					# pc17
+ [ qw(i m n) ],					# pc18
  undef ,						# pc19 has to be validated manually
  undef ,						# pc20 no validation
- [ qw(c m h) ],					# pc21
+ [ qw(i c m h) ],					# pc21
  undef ,						# pc22 no validation
- [ qw(d n n n n m c c h) ],		# pc23
- [ qw(c p h) ],					# pc24
- [ qw(c c n n) ],				# pc25
- [ qw(f m d t m c c bc) ],		# pc26
- [ qw(d n n n n m c c bc) ],	# pc27
- [ qw(c c m c d t p m bp n p bp bc) ], # pc28
- [ qw(c c n m) ],				# pc29
- [ qw(c c n) ],					# pc30
- [ qw(c c n) ],					# pc31
- [ qw(c c n) ],					# pc32
- [ qw(c c n) ],					# pc33
- [ qw(c c m) ],					# pc34
- [ qw(c c m) ],					# pc35
- [ qw(c c m) ],					# pc36
- [ qw(c c n m) ],				# pc37
+ [ qw(i d n n n n m c c h) ],		# pc23
+ [ qw(i c p h) ],					# pc24
+ [ qw(i c c n n) ],				# pc25
+ [ qw(i f m d t m c c bc) ],		# pc26
+ [ qw(i d n n n n m c c bc) ],	# pc27
+ [ qw(i c c m c d t p m bp n p bp bc) ], # pc28
+ [ qw(i c c n m) ],				# pc29
+ [ qw(i c c n) ],					# pc30
+ [ qw(i c c n) ],					# pc31
+ [ qw(i c c n) ],					# pc32
+ [ qw(i c c n) ],					# pc33
+ [ qw(i c c m) ],					# pc34
+ [ qw(i c c m) ],					# pc35
+ [ qw(i c c m) ],					# pc36
+ [ qw(i c c n m) ],				# pc37
  undef,							# pc38 not interested
- [ qw(c m) ],					# pc39
- [ qw(c c m p n) ],				# pc40
- [ qw(c n m h) ],				# pc41
- [ qw(c c n) ],					# pc42
+ [ qw(i c m) ],					# pc39
+ [ qw(i c c m p n) ],				# pc40
+ [ qw(i c n m h) ],				# pc41
+ [ qw(i c c n) ],					# pc42
  undef,							# pc43 don't handle it
- [ qw(c c n m m c) ],			# pc44
- [ qw(c c n m) ],				# pc45
- [ qw(c c n) ],					# pc46
+ [ qw(i c c n m m c) ],			# pc44
+ [ qw(i c c n m) ],				# pc45
+ [ qw(i c c n) ],					# pc46
  undef,							# pc47
  undef,							# pc48
- [ qw(c m h) ],					# pc49
- [ qw(c n h) ],					# pc50
- [ qw(c c n) ],					# pc51
+ [ qw(i c m h) ],					# pc49
+ [ qw(i c n h) ],					# pc50
+ [ qw(i c c n) ],					# pc51
  undef,
  undef,
  undef,
@@ -137,7 +137,7 @@ $chatdupeage = 20 * 60 * 60;
  undef,							# pc70
  undef,
  undef,
- [ qw(d n n n n n n m m m c c h) ],	# pc73
+ [ qw(i d n n n n n n m m m c c h) ],	# pc73
  undef,
  undef,
  undef,
@@ -148,8 +148,13 @@ $chatdupeage = 20 * 60 * 60;
  undef,
  undef,
  undef,
- [ qw(c c c m) ],				# pc84
- [ qw(c c c m) ],				# pc85
+ [ qw(i c c c m) ],				# pc84
+ [ qw(i c c c m) ],				# pc85
+ undef,
+ undef,
+ undef,
+ undef,
+ [ qw(i c n) ],					# pc90
 );
 
 # use the entry in the check list to check the field list presented
@@ -163,28 +168,29 @@ sub check
 	return 0 unless ref $ref;
 	
 	my $i;
-	shift;    # not interested in the first field
-	for ($i = 0; $i < @$ref; $i++) {
+	for ($i = 1; $i < @$ref; $i++) {
 		my ($blank, $act) = $$ref[$i] =~ /^(b?)(\w)$/;
 		return 0 unless $act;
 		next if $blank && $_[$i] =~ /^[ \*]$/;
 		if ($act eq 'c') {
-			return $i+1 unless is_callsign($_[$i]);
+			return $i unless is_callsign($_[$i]);
+		} elsif ($act eq 'i') {			
+			;					# do nothing
 		} elsif ($act eq 'm') {
-			return $i+1 unless is_pctext($_[$i]);
+			return $i unless is_pctext($_[$i]);
 		} elsif ($act eq 'p') {
-			return $i+1 unless is_pcflag($_[$i]);
+			return $i unless is_pcflag($_[$i]);
 		} elsif ($act eq 'f') {
-			return $i+1 unless is_freq($_[$i]);
+			return $i unless is_freq($_[$i]);
 		} elsif ($act eq 'n') {
-			return $i+1 unless $_[$i] =~ /^[\d ]+$/;
+			return $i unless $_[$i] =~ /^[\d ]+$/;
 		} elsif ($act eq 'h') {
-			return $i+1 unless $_[$i] =~ /^H\d\d?$/;
+			return $i unless $_[$i] =~ /^H\d\d?$/;
 		} elsif ($act eq 'd') {
-			return $i+1 unless $_[$i] =~ /^\s*\d+-\w\w\w-[12][90]\d\d$/;
+			return $i unless $_[$i] =~ /^\s*\d+-\w\w\w-[12][90]\d\d$/;
 		} elsif ($act eq 't') {
-			return $i+1 unless $_[$i] =~ /^[012]\d[012345]\dZ$/;
-		}
+			return $i unless $_[$i] =~ /^[012]\d[012345]\dZ$/;
+		} 
 	}
 	return 0;
 }
@@ -295,6 +301,57 @@ sub sendinit
 	$self->send(pc18());
 }
 
+sub removepc90
+{
+	$_[0] =~ s/^PC90\^[-A-Z0-9]+\^\d+\^//;
+}
+
+sub removepc91
+{
+	$_[0] =~ s/^PC91\^[-A-Z0-9]+\^\d+\^[-A-Z0-9]+\^//;
+}
+
+sub send
+{
+	my $self = shift;
+	while (@_) {
+		my $line = shift;
+		if ($self->user->wantpc90) {
+			$line = mungepc90($line);
+		} else {
+			removepc91($line);
+			removepc90($line);
+		}
+		$self->SUPER::send($line);
+	}
+}
+
+my $pc90msgid = 0;
+
+sub nextpc90
+{
+	$pc90msgid = 0 if $pc90msgid > 9999;
+	return $pc90msgid++;
+}
+
+sub mungepc90
+{
+	unless ($_[0] =~ /^PC9\d/) {
+		my $id = nextpc90();
+		return "PC90^$main::mycall^$id^" . $_[0]; 
+	} 
+	return $_[0];
+}
+
+sub mungepc91
+{
+	unless ($_[1] =~ /^PC9\d/) {
+		my $id = nextpc90();
+		return "PC91^$main::mycall^$id^$_[0]^" . $_[1]; 
+	} 
+	return $_[1];
+}
+
 #
 # This is the normal pcxx despatcher
 #
@@ -311,8 +368,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);
@@ -321,20 +380,75 @@ sub normal
 		return;
 	}
 
-	# local processing 1
-	my $pcr;
-	eval {
-		$pcr = Local::pcprot($self, $pcno, @field);
-	};
-#	dbg("Local::pcprot error $@") if isdbg('local') if $@;
-	return if $pcr;
+	# 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;
+		}
+		$self->user->wantpc90(1) unless $self->user->wantpc90 || $origin ne $self->{call};
+		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;
+			$origin = shift @field if $pcno == 91;
+
+			($pcno) = $field[0] =~ /^PC(\d\d)/; # just get the number
+			unless (defined $pcno && $pcno >= 10 && $pcno <= 89) {
+				dbg("PCPROT: unknown protocol") if isdbg('chanerr');
+				return;
+			}
+			
+			# 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;
+			}
+		}
+	} else {
+		if ($pcno == 16 || $pcno == 17 || $pcno == 19 || $pcno == 21) {
+			$line = mungepc91($origin, $line);
+		} else {
+			$line = mungepc90($line);
+		}
+	}
 
 	no strict 'subs';
 	my $sub = "handle_$pcno";
+
 	if ($self->can($sub)) {
-		$self->$sub($pcno, $line, @field);
+		$self->$sub($pcno, $line, $origin, @field);
 	} else {
-		$self->handle_default($pcno, $line, @field);
+		$self->handle_default($pcno, $line, $origin, @field);
 	}
 }
 	
@@ -344,8 +458,9 @@ sub handle_10
 	my $self = shift;
 	my $pcno = shift;
 	my $line = shift;
+	my $origin = shift;
 
-			# rsfp check
+	# rsfp check
 	return if $rspfcheck and !$self->rspfcheck(0, $_[6], $_[1]);
 			
 	# will we allow it at all?
@@ -425,6 +540,7 @@ sub handle_11
 	my $self = shift;
 	my $pcno = shift;
 	my $line = shift;
+	my $origin = shift;
 
 	# route 'foreign' pc26s 
 	if ($pcno == 26) {
@@ -577,6 +693,7 @@ sub handle_12
 	my $self = shift;
 	my $pcno = shift;
 	my $line = shift;
+	my $origin = shift;
 
 	#			return if $rspfcheck and !$self->rspfcheck(1, $_[5], $_[1]);
 
@@ -645,7 +762,7 @@ sub handle_16
 	my $self = shift;
 	my $pcno = shift;
 	my $line = shift;
-
+	my $origin = shift;
 
 	if (eph_dup($line)) {
 		dbg("PCPROT: dup PC16 detected") if isdbg('chanerr');
@@ -710,7 +827,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?");
@@ -780,8 +897,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
@@ -790,6 +906,7 @@ sub handle_17
 	my $self = shift;
 	my $pcno = shift;
 	my $line = shift;
+	my $origin = shift;
 	my $dxchan;
 	my $ncall = $_[2];
 	my $ucall = $_[1];
@@ -833,7 +950,7 @@ sub handle_17
 		return;
 	}
 
-	$self->route_pc17($parent, $uref);
+	$self->route_pc17($origin, $line, $parent, $uref);
 }
 		
 # link request
@@ -842,6 +959,7 @@ sub handle_18
 	my $self = shift;
 	my $pcno = shift;
 	my $line = shift;
+	my $origin = shift;
 	$self->state('init');	
 
 	# record the type and version offered
@@ -864,7 +982,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());
 }
@@ -875,6 +993,7 @@ sub handle_19
 	my $self = shift;
 	my $pcno = shift;
 	my $line = shift;
+	my $origin = shift;
 
 	my $i;
 	my $newline = "PC19^";
@@ -974,7 +1093,7 @@ sub handle_19
 	}
 
 
-	$self->route_pc19(@rout) if @rout;
+	$self->route_pc19($origin, $line, @rout) if @rout;
 }
 		
 # send local configuration
@@ -983,6 +1102,7 @@ sub handle_20
 	my $self = shift;
 	my $pcno = shift;
 	my $line = shift;
+	my $origin = shift;
 	$self->send_local_config();
 	$self->send(pc22());
 	$self->state('normal');
@@ -995,6 +1115,7 @@ sub handle_21
 	my $self = shift;
 	my $pcno = shift;
 	my $line = shift;
+	my $origin = shift;
 	my $call = uc $_[1];
 
 	eph_del_regex("^PC1[679].*$call");
@@ -1042,7 +1163,7 @@ sub handle_21
 		}
 	}
 
-	$self->route_pc21(@rout) if @rout;
+	$self->route_pc21($origin, $line, @rout) if @rout;
 }
 		
 
@@ -1051,6 +1172,7 @@ sub handle_22
 	my $self = shift;
 	my $pcno = shift;
 	my $line = shift;
+	my $origin = shift;
 	$self->state('normal');
 	$self->{lastping} = 0;
 }
@@ -1061,6 +1183,7 @@ sub handle_23
 	my $self = shift;
 	my $pcno = shift;
 	my $line = shift;
+	my $origin = shift;
 			
 	# route foreign' pc27s 
 	if ($pcno == 27) {
@@ -1111,6 +1234,7 @@ sub handle_24
 	my $self = shift;
 	my $pcno = shift;
 	my $line = shift;
+	my $origin = shift;
 	my $call = uc $_[1];
 	my ($nref, $uref);
 	$nref = Route::Node::get($call);
@@ -1127,7 +1251,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
@@ -1136,6 +1260,7 @@ sub handle_25
 	my $self = shift;
 	my $pcno = shift;
 	my $line = shift;
+	my $origin = shift;
 	if ($_[1] ne $main::mycall) {
 		$self->route($_[1], $line);
 		return;
@@ -1175,6 +1300,7 @@ sub handle_28
 	my $self = shift;
 	my $pcno = shift;
 	my $line = shift;
+	my $origin = shift;
 	if ($_[1] eq $main::mycall) {
 		no strict 'refs';
 		my $sub = "DXMsg::handle_$pcno";
@@ -1195,6 +1321,7 @@ sub handle_34
 	my $self = shift;
 	my $pcno = shift;
 	my $line = shift;
+	my $origin = shift;
 	if (eph_dup($line, $eph_pc34_restime)) {
 		dbg("PCPROT: dupe PC34, ignored") if isdbg('chanerr');
 	} else {
@@ -1208,6 +1335,7 @@ sub handle_35
 	my $self = shift;
 	my $pcno = shift;
 	my $line = shift;
+	my $origin = shift;
 	eph_del_regex("^PC35\\^$_[2]\\^$_[1]\\^");
 	$self->process_rcmd_reply($_[1], $_[2], $_[1], $_[3]);
 }
@@ -1220,6 +1348,7 @@ sub handle_37
 	my $self = shift;
 	my $pcno = shift;
 	my $line = shift;
+	my $origin = shift;
 	DXDb::process($self, $line);
 }
 
@@ -1229,6 +1358,7 @@ sub handle_38
 	my $self = shift;
 	my $pcno = shift;
 	my $line = shift;
+	my $origin = shift;
 }
 		
 # incoming disconnect
@@ -1237,6 +1367,7 @@ sub handle_39
 	my $self = shift;
 	my $pcno = shift;
 	my $line = shift;
+	my $origin = shift;
 	if ($_[1] eq $self->{call}) {
 		$self->disconnect(1);
 	} else {
@@ -1252,6 +1383,7 @@ sub handle_41
 	my $self = shift;
 	my $pcno = shift;
 	my $line = shift;
+	my $origin = shift;
 	my $call = $_[1];
 
 	my $l = $line;
@@ -1328,6 +1460,7 @@ sub handle_49
 	my $self = shift;
 	my $pcno = shift;
 	my $line = shift;
+	my $origin = shift;
 
 	if (eph_dup($line)) {
 		dbg("PCPROT: Dup PC49 ignored\n") if isdbg('chanerr');
@@ -1347,6 +1480,7 @@ sub handle_50
 	my $self = shift;
 	my $pcno = shift;
 	my $line = shift;
+	my $origin = shift;
 
 	my $call = $_[1];
 	my $node = Route::Node::get($call);
@@ -1357,7 +1491,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);
 	}
 }
 		
@@ -1367,6 +1501,7 @@ sub handle_51
 	my $self = shift;
 	my $pcno = shift;
 	my $line = shift;
+	my $origin = shift;
 	my $to = $_[1];
 	my $from = $_[2];
 	my $flag = $_[3];
@@ -1414,7 +1549,7 @@ sub handle_51
 			}
 		}
 	} else {
-		if (eph_dup($line)) {
+		if ($line !~ /^PC90/ && eph_dup($line)) {
 			dbg("PCPROT: dup PC51 detected") if isdbg('chanerr');
 			return;
 		}
@@ -1429,6 +1564,7 @@ sub handle_75
 	my $self = shift;
 	my $pcno = shift;
 	my $line = shift;
+	my $origin = shift;
 	my $call = $_[1];
 	if ($call ne $main::mycall) {
 		$self->route($call, $line);
@@ -1441,6 +1577,7 @@ sub handle_73
 	my $self = shift;
 	my $pcno = shift;
 	my $line = shift;
+	my $origin = shift;
 	my $call = $_[1];
 			
 	# do some de-duping
@@ -1474,6 +1611,7 @@ sub handle_84
 	my $self = shift;
 	my $pcno = shift;
 	my $line = shift;
+	my $origin = shift;
 	$self->process_rcmd($_[1], $_[2], $_[3], $_[4]);
 }
 
@@ -1483,9 +1621,10 @@ sub handle_85
 	my $self = shift;
 	my $pcno = shift;
 	my $line = shift;
+	my $origin = shift;
 	$self->process_rcmd_reply($_[1], $_[2], $_[3], $_[4]);
 }
-	
+
 # if get here then rebroadcast the thing with its Hop count decremented (if
 # there is one). If it has a hop count and it decrements to zero then don't
 # rebroadcast it.
@@ -1499,6 +1638,7 @@ sub handle_default
 	my $self = shift;
 	my $pcno = shift;
 	my $line = shift;
+	my $origin = shift;
 
 	if (eph_dup($line)) {
 		dbg("PCPROT: Ephemeral dup, dropped") if isdbg('chanerr');
@@ -1603,7 +1743,8 @@ sub send_prot_line
 {
 	my ($self, $filter, $hops, $isolate, $line) = @_;
 	my $routeit;
-	
+
+
 	if ($hops) {
 		$routeit = $line;
 		$routeit =~ s/\^H\d+\^\~$/\^H$hops\^\~/;
@@ -1649,7 +1790,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
@@ -1897,29 +2037,48 @@ sub send_local_config
 	# send our nodes
 	if ($self->{isolate}) {
 		@localnodes = ( $main::routeroot );
+		$self->send_route($main::mycall, \&pc19, 1, $main::routeroot, $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;
-		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;
+		$self->send_route($main::mycall, \&pc19, scalar(@localnodes)+1, $main::routeroot, @localnodes);
+
+		my $node;
+		if ($self->user->wantpc90) {
+			for $node (@localnodes) {
+				my @nodes = map {my $r = Route::Node::get($_); $r ? $r : ()} $node->nodes;
+				$self->send_route($node->call, \&pc19, scalar(@nodes)+1, @nodes);
+				for my $r (@nodes) {
+					push @remotenodes, $r unless grep $r eq $_, @remotenodes;
+				}
+			}
+		} else {
+			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 $node (@intcalls) {
+				push @remotenodes, Route::Node::get($node) unless grep $node eq $_, @rnodes, @remotenodes;
+			}
+			$self->send_route($main::mycall, \&pc19, scalar(@remotenodes), @remotenodes);
 		}
-		unshift @localnodes, $main::routeroot;
 	}
 	
 
-	$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');
 		}
@@ -2175,7 +2334,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
@@ -2207,9 +2366,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;
@@ -2244,6 +2405,8 @@ sub send_route
 				$routeit = adjust_hops($self, $line);  # adjust its hop count by node name
 				next unless $routeit;
 			}
+			
+			$routeit = mungepc91($origin, $routeit) if $self->user->wantpc90;
 			$self->send($routeit);
 		}
 	}
@@ -2252,10 +2415,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) {
@@ -2264,7 +2428,11 @@ sub broadcast_route
 			next unless $dxchan->isa('DXProt');
 			next if ($generate == \&pc16 || $generate==\&pc17) && !$dxchan->user->wantsendpc16;
  
-			$dxchan->send_route($generate, @_);
+			if ($self->user->wantpc90 && $line) {
+				$dxchan->send(mungepc91($origin, $line));
+			} else {
+				$dxchan->send_route($origin, $generate, @_);
+			}
 		}
 	}
 }
@@ -2273,44 +2441,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
@@ -2334,6 +2516,7 @@ 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;