X-Git-Url: http://dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXProt.pm;h=d51b9f1a7e256193985b0919f4523aec28d50957;hb=817ce3f71cc80d27ceaca7706800ce1ac7e94b51;hp=9dc9d5e48506d90961d15ef5e6295a43f58ef9c5;hpb=331ae9a34defd23c476ceaecdf29d9f49b60faed;p=spider.git

diff --git a/perl/DXProt.pm b/perl/DXProt.pm
index 9dc9d5e4..d51b9f1a 100644
--- a/perl/DXProt.pm
+++ b/perl/DXProt.pm
@@ -50,7 +50,8 @@ use vars qw($pc11_max_age $pc23_max_age $last_pc50 $eph_restime $eph_info_restim
 			$pingint $obscount %pc19list $chatdupeage $chatimportfn
 			$investigation_int $pc19_version $myprot_version
 			%nodehops $baddx $badspotter $badnode $censorpc $rspfcheck
-			$allowzero $decode_dk0wcy $send_opernam @checklist);
+			$allowzero $decode_dk0wcy $send_opernam @checklist
+			$handle_xml);
 
 $pc11_max_age = 1*3600;			# the maximum age for an incoming 'real-time' pc11
 $pc23_max_age = 1*3600;			# the maximum age for an incoming 'real-time' pc23
@@ -78,11 +79,12 @@ $chatdupeage = 20 * 60 * 60;
 $chatimportfn = "$main::root/chat_import";
 $investigation_int = 12*60*60;	# time between checks to see if we can see this node
 $pc19_version = 5466;			# the visible version no for outgoing PC19s generated from pc59
+$handle_xml = 0;				# handle XML sentences
 
 @checklist = 
 (
  [ qw(i c c m bp bc c) ],			# pc10
- [ qw(i f m d t m c c h) ],		# pc11
+ [ qw(i f bm 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) ],					# 
@@ -249,7 +251,10 @@ sub start
 	my $user = $self->{user};
 
 	# log it
-	my $host = $self->{conn}->{peerhost} || "unknown";
+	my $host = $self->{conn}->{peerhost};
+	$host ||= "AGW Port #$self->{conn}->{agwport}" if exists $self->{conn}->{agwport};
+	$host ||= "unknown";
+
 	Log('DXProt', "$call connected from $host");
 	
 	# remember type of connection
@@ -296,7 +301,7 @@ sub start
 	$self->{pingave} = 999;
 	$self->{metric} ||= 100;
 	$self->{lastping} = $main::systime;
-
+	
 	# send initialisation string
 	unless ($self->{outbound}) {
 		$self->sendinit;
@@ -323,21 +328,6 @@ sub sendinit
 	$self->send(pc18());
 }
 
-sub removepc90
-{
-	$_[0] =~ s/^PC90\^[-A-Z0-9]+\^\d+\^//;
-	$_[0] =~ s/^PC91\^[-A-Z0-9]+\^\d+\^[-A-Z0-9]+\^//;
-}
-
-#sub send
-#{
-#	my $self = shift;
-#	while (@_) {
-#		my $line = shift;
-#		$self->SUPER::send($line);
-#	}
-#}
-
 #
 # This is the normal pcxx despatcher
 #
@@ -345,8 +335,10 @@ sub normal
 {
 	my ($self, $line) = @_;
 
-	# remove any incoming PC90 frames
-	removepc90($line);
+	if ($line =~ '^<\w+\s') {
+		DXXml::normal($self, $line);
+		return;
+	}
 
 	my @field = split /\^/, $line;
 	return unless @field;
@@ -438,8 +430,8 @@ sub handle_10
 #	RouteDB::update($to, $_[6]);
 
 	# it is here and logged on
-	$dxchan = DXChannel->get($main::myalias) if $to eq $main::mycall;
-	$dxchan = DXChannel->get($to) unless $dxchan;
+	$dxchan = DXChannel::get($main::myalias) if $to eq $main::mycall;
+	$dxchan = DXChannel::get($to) unless $dxchan;
 	if ($dxchan && $dxchan->is_user) {
 		$_[3] =~ s/\%5E/^/g;
 		$dxchan->talk($from, $to, $via, $_[3]);
@@ -548,7 +540,7 @@ sub handle_11
 	# this goes after the input filtering, but before the add
 	# so that if it is input filtered, it isn't added to the dup
 	# list. This allows it to come in from a "legitimate" source
-	if (Spot::dup(@spot[0..4])) {
+	if (Spot::dup(@spot[0..4,5])) {
 		dbg("PCPROT: Duplicate Spot ignored\n") if isdbg('chanerr');
 		return;
 	}
@@ -663,7 +655,7 @@ sub handle_12
 
 	my $dxchan;
 	
-	if ((($dxchan = DXChannel->get($_[2])) && $dxchan->is_user) || $_[4] =~ /^[\#\w.]+$/){
+	if ((($dxchan = DXChannel::get($_[2])) && $dxchan->is_user) || $_[4] =~ /^[\#\w.]+$/){
 		$self->send_chat($line, @_[1..6]);
 	} elsif ($_[2] eq '*' || $_[2] eq $main::mycall) {
 
@@ -779,7 +771,7 @@ sub handle_16
 						}
 					}
 					$user->wantroutepc19(1) unless defined $wantpc19; # for now we work on the basis that pc16 = real route 
-					$user->lastin($main::systime) unless DXChannel->get($ncall);
+					$user->lastin($main::systime) unless DXChannel::get($ncall);
 					$user->put;
 						
 					# route the pc19 - this will cause 'stuttering PC19s' for a while
@@ -850,7 +842,7 @@ sub handle_16
 		$user = DXUser->new($call) if !$user;
 		$user->homenode($parent->call) if !$user->homenode;
 		$user->node($parent->call);
-		$user->lastin($main::systime) unless DXChannel->get($call);
+		$user->lastin($main::systime) unless DXChannel::get($call);
 		$user->put;
 	}
 	$self->route_pc16($origin, $line, $parent, @rout) if @rout;
@@ -943,6 +935,7 @@ sub handle_18
 			$self->user->put;
 			$self->sort('S');
 		}
+		$self->{handle_xml}++ if $_[1] =~ /\bxml\b/;
 	} else {
 		$self->version(50.0);
 		$self->version($_[2] / 100) if $_[2] && $_[2] =~ /^\d+$/;
@@ -1016,7 +1009,7 @@ sub handle_19
 		next if $call eq $main::mycall;
 
 		# check that this PC19 isn't trying to alter the wrong dxchan
-		my $dxchan = DXChannel->get($call);
+		my $dxchan = DXChannel::get($call);
 		if ($dxchan && $dxchan != $self) {
 			dbg("PCPROT: PC19 from $self->{call} trying to alter wrong locally connected $call, ignored!") if isdbg('chanerr');
 			next;
@@ -1098,7 +1091,7 @@ sub handle_19
 		my $mref = DXMsg::get_busy($call);
 		$mref->stop_msg($call) if $mref;
 				
-		$user->lastin($main::systime) unless DXChannel->get($call);
+		$user->lastin($main::systime) unless DXChannel::get($call);
 		$user->put;
 	}
 
@@ -1167,7 +1160,7 @@ sub handle_21
 			my $node = Route::Node::get($call);
 			if ($node) {
 						
-				my $dxchan = DXChannel->get($call);
+				my $dxchan = DXChannel::get($call);
 				if ($dxchan && $dxchan != $self) {
 					dbg("PCPROT: PC21 from $self->{call} trying to alter locally connected $call, ignored!") if isdbg('chanerr');
 					return;
@@ -1231,13 +1224,24 @@ sub handle_23
 		dbg("PCPROT: WWV Date ($_[1] $_[2]) out of range") if isdbg('chanerr');
 		return;
 	}
-	if (Geomag::dup($d,$sfi,$k,$i,$_[6])) {
+
+	# global wwv filtering on INPUT
+	my @dxcc = ((Prefix::cty_data($_[7]))[0..2], (Prefix::cty_data($_[8]))[0..2]);
+	if ($self->{inwwvfilter}) {
+		my ($filter, $hops) = $self->{inwwvfilter}->it(@_[7,8], $origin, @dxcc);
+		unless ($filter) {
+			dbg("PCPROT: Rejected by input wwv filter") if isdbg('chanerr');
+			return;
+		}
+	}
+	$_[7] =~ s/-\d+$//o;		# remove spotter's ssid
+	if (Geomag::dup($d,$sfi,$k,$i,$_[6],$_[7])) {
 		dbg("PCPROT: Dup WWV Spot ignored\n") if isdbg('chanerr');
 		return;
 	}
-	$_[7] =~ s/-\d+$//o;		# remove spotter's ssid
 		
-	my $wwv = Geomag::update($d, $_[2], $sfi, $k, $i, @_[6..8], $r);
+	# note this only takes the first one it gets
+	Geomag::update($d, $_[2], $sfi, $k, $i, @_[6..8], $r);
 
 	my $rep;
 	eval {
@@ -1546,48 +1550,7 @@ sub handle_51
 		if ($flag == 1) {
 			$self->send(pc51($from, $to, '0'));
 		} else {
-			# it's a reply, look in the ping list for this one
-			my $ref = $pings{$from};
-			if ($ref) {
-				my $tochan =  DXChannel->get($from);
-				while (@$ref) {
-					my $r = shift @$ref;
-					my $dxchan = DXChannel->get($r->{call});
-					next unless $dxchan;
-					my $t = tv_interval($r->{t}, [ gettimeofday ]);
-					if ($dxchan->is_user) {
-						my $s = sprintf "%.2f", $t; 
-						my $ave = sprintf "%.2f", $tochan ? ($tochan->{pingave} || $t) : $t;
-						$dxchan->send($dxchan->msg('pingi', $from, $s, $ave))
-					} elsif ($dxchan->is_node) {
-						if ($tochan) {
-							my $nopings = $tochan->user->nopings || $obscount;
-							push @{$tochan->{pingtime}}, $t;
-							shift @{$tochan->{pingtime}} if @{$tochan->{pingtime}} > 6;
-							
-							# cope with a missed ping, this means you must set the pingint large enough
-							if ($t > $tochan->{pingint}  && $t < 2 * $tochan->{pingint} ) {
-								$t -= $tochan->{pingint};
-							}
-							
-							# calc smoothed RTT a la TCP
-							if (@{$tochan->{pingtime}} == 1) {
-								$tochan->{pingave} = $t;
-							} else {
-								$tochan->{pingave} = $tochan->{pingave} + (($t - $tochan->{pingave}) / 6);
-							}
-							$tochan->{nopings} = $nopings; # pump up the timer
-							if (my $ivp = Investigate::get($from, $self->{call})) {
-								$ivp->handle_ping;
-							}
-						} elsif (my $rref = Route::Node::get($r->{call})) {
-							if (my $ivp = Investigate::get($from, $self->{call})) {
-								$ivp->handle_ping;
-							}
-						}
-					}
-				}
-			}
+			$self->handle_ping_reply($from);
 		}
 	} else {
 
@@ -1602,6 +1565,56 @@ sub handle_51
 	}
 }
 
+sub handle_ping_reply
+{
+	my $self = shift;
+	my $from = shift;
+	my $id = shift;
+	
+	# it's a reply, look in the ping list for this one
+	my $ref = $pings{$from};
+	return unless $ref;
+
+	my $tochan =  DXChannel::get($from);
+	while (@$ref) {
+		my $r = shift @$ref;
+		my $dxchan = DXChannel::get($r->{call});
+		next unless $dxchan;
+		my $t = tv_interval($r->{t}, [ gettimeofday ]);
+		if ($dxchan->is_user) {
+			my $s = sprintf "%.2f", $t; 
+			my $ave = sprintf "%.2f", $tochan ? ($tochan->{pingave} || $t) : $t;
+			$dxchan->send($dxchan->msg('pingi', $from, $s, $ave))
+		} elsif ($dxchan->is_node) {
+			if ($tochan) {
+				my $nopings = $tochan->user->nopings || $obscount;
+				push @{$tochan->{pingtime}}, $t;
+				shift @{$tochan->{pingtime}} if @{$tochan->{pingtime}} > 6;
+				
+				# cope with a missed ping, this means you must set the pingint large enough
+				if ($t > $tochan->{pingint}  && $t < 2 * $tochan->{pingint} ) {
+					$t -= $tochan->{pingint};
+				}
+				
+				# calc smoothed RTT a la TCP
+				if (@{$tochan->{pingtime}} == 1) {
+					$tochan->{pingave} = $t;
+				} else {
+					$tochan->{pingave} = $tochan->{pingave} + (($t - $tochan->{pingave}) / 6);
+				}
+				$tochan->{nopings} = $nopings; # pump up the timer
+				if (my $ivp = Investigate::get($from, $self->{call})) {
+					$ivp->handle_ping;
+				}
+			} elsif (my $rref = Route::Node::get($r->{call})) {
+				if (my $ivp = Investigate::get($from, $self->{call})) {
+					$ivp->handle_ping;
+				}
+			}
+		}
+	}
+}
+
 # dunno but route it
 sub handle_75
 {
@@ -1700,7 +1713,7 @@ sub handle_default
 sub process
 {
 	my $t = time;
-	my @dxchan = DXChannel->get_all();
+	my @dxchan = DXChannel::get_all();
 	my $dxchan;
 	my $pc50s;
 	
@@ -1712,7 +1725,8 @@ sub process
 	}
 
 	foreach $dxchan (@dxchan) {
-		next unless $dxchan->is_node();
+		next unless $dxchan->is_node;
+		next if $dxchan->handle_xml;
 		next if $dxchan == $main::me;
 
 		# send the pc50
@@ -1726,6 +1740,7 @@ sub process
 				addping($main::mycall, $dxchan->call);
 				$dxchan->{nopings} -= 1;
 				$dxchan->{lastping} = $t;
+				$dxchan->{lastping} += $dxchan->{pingint} / 2 unless @{$dxchan->{pingtime}};
 			}
 		}
 	}
@@ -1761,7 +1776,7 @@ sub send_dx_spot
 {
 	my $self = shift;
 	my $line = shift;
-	my @dxchan = DXChannel->get_all();
+	my @dxchan = DXChannel::get_all();
 	my $dxchan;
 	
 	# send it if it isn't the except list and isn't isolated and still has a hop count
@@ -1812,7 +1827,7 @@ sub send_wwv_spot
 {
 	my $self = shift;
 	my $line = shift;
-	my @dxchan = DXChannel->get_all();
+	my @dxchan = DXChannel::get_all();
 	my $dxchan;
 	my @dxcc = ((Prefix::cty_data($_[6]))[0..2], (Prefix::cty_data($_[7]))[0..2]);
 
@@ -1836,7 +1851,7 @@ sub wwv
 	my ($filter, $hops);
 	
 	if ($self->{wwvfilter}) {
-		($filter, $hops) = $self->{wwvfilter}->it(@_);
+		($filter, $hops) = $self->{wwvfilter}->it(@_[7..$#_]);
 		return unless $filter;
 	}
 	send_prot_line($self, $filter, $hops, $isolate, $line)
@@ -1846,7 +1861,7 @@ sub send_wcy_spot
 {
 	my $self = shift;
 	my $line = shift;
-	my @dxchan = DXChannel->get_all();
+	my @dxchan = DXChannel::get_all();
 	my $dxchan;
 	my @dxcc = ((Prefix::cty_data($_[10]))[0..2], (Prefix::cty_data($_[11]))[0..2]);
 	
@@ -1879,7 +1894,7 @@ sub send_announce
 {
 	my $self = shift;
 	my $line = shift;
-	my @dxchan = DXChannel->get_all();
+	my @dxchan = DXChannel::get_all();
 	my $dxchan;
 	my $target;
 	my $to = 'To ';
@@ -1944,7 +1959,7 @@ sub send_chat
 {
 	my $self = shift;
 	my $line = shift;
-	my @dxchan = DXChannel->get_all();
+	my @dxchan = DXChannel::get_all();
 	my $dxchan;
 	my $target = $_[3];
 	my $text = unpad($_[2]);
@@ -2085,7 +2100,7 @@ sub route
 	}
 
 	# always send it down the local interface if available
-	my $dxchan = DXChannel->get($call);
+	my $dxchan = DXChannel::get($call);
 	if ($dxchan) {
 		dbg("route: $call -> $dxchan->{call} direct" ) if isdbg('route');
 	} else {
@@ -2108,7 +2123,7 @@ sub route
 				dbg("PCPROT: Trying to route back to source, dropped") if isdbg('chanerr');
 				return;
 			}
-			$dxchan = DXChannel->get($rcall);
+			$dxchan = DXChannel::get($rcall);
 			dbg("route: $call -> $rcall using RouteDB" ) if isdbg('route') && $dxchan;
 		}
 	}
@@ -2189,7 +2204,7 @@ sub addping
 	my $r = {};
 	$r->{call} = $from;
 	$r->{t} = [ gettimeofday ];
-	if ($via && (my $dxchan = DXChannel->get($via))) {
+	if ($via && (my $dxchan = DXChannel::get($via))) {
 		$dxchan->send(pc51($to, $main::mycall, 1));
 	} else {
 		route(undef, $to, pc51($to, $main::mycall, 1));
@@ -2241,13 +2256,13 @@ sub process_rcmd_reply
 	if ($tonode eq $main::mycall) {
 		my $s = $rcmds{$fromnode};
 		if ($s) {
-			my $dxchan = DXChannel->get($s->{call});
-			my $ref = $user eq $tonode ? $dxchan : (DXChannel->get($user) || $dxchan);
+			my $dxchan = DXChannel::get($s->{call});
+			my $ref = $user eq $tonode ? $dxchan : (DXChannel::get($user) || $dxchan);
 			$ref->send($line) if $ref;
 			delete $rcmds{$fromnode} if !$dxchan;
 		} else {
 			# send unsolicited ones to the sysop
-			my $dxchan = DXChannel->get($main::myalias);
+			my $dxchan = DXChannel::get($main::myalias);
 			$dxchan->send($line) if $dxchan;
 		}
 	} else {