X-Git-Url: http://dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXProt.pm;h=71cef0e220d81071f5ddf931973020cb301a1b49;hb=f52bf428cfd46825c2e2fcd3a0ba55097bbe7bd6;hp=ca6e4728466d2febcb7f12639235f38c30373632;hpb=72568e838d146250a78fea19bd4bbafc760e6a49;p=spider.git

diff --git a/perl/DXProt.pm b/perl/DXProt.pm
index ca6e4728..71cef0e2 100644
--- a/perl/DXProt.pm
+++ b/perl/DXProt.pm
@@ -32,6 +32,7 @@ use BadWords;
 use DXHash;
 use Route;
 use Route::Node;
+use Script;
 
 use strict;
 
@@ -41,12 +42,11 @@ $BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/ ) || 0;
 $main::build += $VERSION;
 $main::branch += $BRANCH;
 
-use vars qw($me $pc11_max_age $pc23_max_age $last_pc50
+use vars qw($pc11_max_age $pc23_max_age $last_pc50
 			$last_hour $last10 %eph  %pings %rcmds $ann_to_talk
-			%nodehops $baddx $badspotter $badnode $censorpc
+			%nodehops $baddx $badspotter $badnode $censorpc $rspfcheck
 			$allowzero $decode_dk0wcy $send_opernam @checklist);
 
-$me = undef;					# the channel id for this cluster
 $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
 
@@ -61,6 +61,7 @@ $badspotter = new DXHash "badspotter";
 $badnode = new DXHash "badnode";
 $last10 = $last_pc50 = time;
 $ann_to_talk = 1;
+$rspfcheck = 1;
 
 @checklist = 
 (
@@ -183,14 +184,17 @@ sub init
 {
 	my $user = DXUser->get($main::mycall);
 	$DXProt::myprot_version += $main::version*100;
-	$me = DXProt->new($main::mycall, 0, $user); 
-	$me->{here} = 1;
-	$me->{state} = "indifferent";
+	$main::me = DXProt->new($main::mycall, 0, $user); 
+	$main::me->{here} = 1;
+	$main::me->{state} = "indifferent";
 	do "$main::data/hop_table.pl" if -e "$main::data/hop_table.pl";
 	confess $@ if $@;
-	$me->{sort} = 'S';    # S for spider
-	$me->{priv} = 9;
-#	$Route::Node::me->adddxchan($me);
+	$main::me->{sort} = 'S';    # S for spider
+	$main::me->{priv} = 9;
+	$main::me->{metric} = 0;
+	$main::me->{pingave} = 0;
+	
+#	$Route::Node::me->adddxchan($main::me);
 }
 
 #
@@ -260,6 +264,7 @@ sub start
 	$self->{nopings} = $user->nopings || 2;
 	$self->{pingtime} = [ ];
 	$self->{pingave} = 999;
+	$self->{metric} ||= 100;
 	$self->{lastping} = $main::systime;
 
 	# send initialisation string
@@ -272,6 +277,10 @@ sub start
 
 	# send info to all logged in thingies
 	$self->tell_login('loginn');
+
+	# run a script send the output to the debug file
+	my $script = new Script(lc $call) || new Script('node_default');
+	$script->run($self) if $script;
 }
 
 #
@@ -311,6 +320,9 @@ sub normal
  SWITCH: {
 		if ($pcno == 10) {		# incoming talk
 
+			# rsfp check
+			return if $rspfcheck and !$self->rspfcheck(0, $field[6], $field[1]);
+			
 			# will we allow it at all?
 			if ($censorpc) {
 				my @bad;
@@ -321,7 +333,8 @@ sub normal
 			}
 
 			# is it for me or one of mine?
-			my ($to, $via, $call, $dxchan);
+			my ($from, $to, $via, $call, $dxchan);
+			$from = $field[1];
 			if ($field[5] gt ' ') {
 				$via = $field[2];
 				$to = $field[5];
@@ -329,12 +342,20 @@ sub normal
 				$to = $field[2];
 			}
 
+			# if we are converting announces to talk is it a dup?
+			if ($ann_to_talk) {
+				if (AnnTalk::is_talk_candidate($from, $field[3]) && AnnTalk::dup($from, $to, $field[3])) {
+					dbg("DXPROT: Dupe talk from announce, dropped") if isdbg('chanerr');
+					return;
+				}
+			}
+
 			# it is here and logged on
 			$dxchan = DXChannel->get($main::myalias) if $to eq $main::mycall;
 			$dxchan = DXChannel->get($to) unless $dxchan;
 			if ($dxchan && $dxchan->is_user) {
 				$field[3] =~ s/\%5E/^/g;
-				$dxchan->talk($field[1], $to, $via, $field[3]);
+				$dxchan->talk($from, $to, $via, $field[3]);
 				return;
 			}
 
@@ -345,17 +366,17 @@ sub normal
 			if ($ref = Route::get($to)) {
 				$vref = Route::Node::get($via) if $via;
 				$vref = undef unless $vref && grep $to eq $_, $vref->users;
-				$ref->dxchan->talk($field[1], $to, $vref ? $via : undef, $field[3], $field[6]);
+				$ref->dxchan->talk($from, $to, $vref ? $via : undef, $field[3], $field[6]);
 				return;
 			}
 
 			# not visible here, send a message of condolence
 			$vref = undef;
-			$ref = Route::get($field[1]);
+			$ref = Route::get($from);
 			$vref = $ref = Route::Node::get($field[6]) unless $ref; 
 			if ($ref) {
 				$dxchan = $ref->dxchan;
-				$dxchan->talk($main::mycall, $field[1], $vref ? $vref->call : undef, $dxchan->msg('talknh', $to) );
+				$dxchan->talk($main::mycall, $from, $vref ? $vref->call : undef, $dxchan->msg('talknh', $to) );
 			}
 			return;
 		}
@@ -370,6 +391,9 @@ sub normal
 				}
 			}
 			
+			# rsfp check
+			return if $rspfcheck and !$self->rspfcheck(1, $field[7], $field[6]);
+
 			# if this is a 'nodx' node then ignore it
 			if ($badnode->in($field[7])) {
 				dbg("PCPROT: Bad Node, dropped") if isdbg('chanerr');
@@ -391,7 +415,7 @@ sub normal
 			}
 
 			# is it 'baddx'
-			if ($baddx->in($field[2])) {
+			if ($baddx->in($field[2]) || BadWords::check($field[2]) || $field[2] =~ /COCK/) {
 				dbg("PCPROT: Bad DX spot, ignored") if isdbg('chanerr');
 				return;
 			}
@@ -499,6 +523,9 @@ sub normal
 		}
 		
 		if ($pcno == 12) {		# announces
+
+			return if $rspfcheck and !$self->rspfcheck(1, $field[5], $field[1]);
+
 			# announce duplicate checking
 			$field[3] =~ s/^\s+//;  # remove leading blanks
 			if (AnnTalk::dup($field[1], $field[2], $field[3])) {
@@ -520,14 +547,13 @@ sub normal
 				# here's a bit of fun, convert incoming ann with a callsign in the first word
 				# or one saying 'to <call>' to a talk if we can route to the recipient
 				if ($ann_to_talk) {
-					my ($to, $call) = $field[3] =~ /^\s*([\w-]+)[\s:]+([\w-]+)/;
-					if ($to && $call) {
-						if ((uc $to eq 'TO' && is_callsign(uc $call)) || is_callsign($call = uc $to)) {
-							my $ref = Route::get($call);
-							if ($ref) {
-								$ref->dxchan->talk($field[1], $call, undef, $field[3], $field[5]);
-								return;
-							}
+					my $call = AnnTalk::is_talk_candidate($field[1], $field[3]);
+					if ($call) {
+						my $ref = Route::get($call);
+						if ($ref) {
+							my $dxchan = $ref->dxchan;
+							$dxchan->talk($field[1], $call, undef, $field[3], $field[5]) if $dxchan != $self;
+							return;
 						}
 					}
 				}
@@ -552,6 +578,11 @@ sub normal
 		
 		if ($pcno == 16) {		# add a user
 
+			if (eph_dup($line)) {
+				dbg("PCPROT: dup PC16 detected") if isdbg('chanerr');
+				return;
+			}
+
 			# general checks
 			my $dxchan;
 			my $ncall = $field[1];
@@ -561,17 +592,17 @@ sub normal
 				dbg("PCPROT: trying to alter config on this node from outside!") if isdbg('chanerr');
 				return;
 			}
-			$dxchan = DXChannel->get($ncall);
-			if ($dxchan && $dxchan ne $self) {
-				dbg("PCPROT: PC16 from $self->{call} trying to alter locally connected $ncall, ignored!") if isdbg('chanerr');
-				return;
-			}
 			my $parent = Route::Node::get($ncall); 
 			unless ($parent) {
 				dbg("PCPROT: Node $ncall not in config") if isdbg('chanerr');
 				return;
 			}
-			
+			$dxchan = $parent->dxchan;
+			if ($dxchan && $dxchan ne $self) {
+				dbg("PCPROT: PC16 from $self->{call} trying to alter locally connected $ncall, ignored!") if isdbg('chanerr');
+				return;
+			}
+
 			# input filter if required
 			return unless $self->in_filter_route($parent);
 			
@@ -616,11 +647,6 @@ sub normal
 				$user->lastin($main::systime) unless DXChannel->get($call);
 				$user->put;
 			}
-
-			if (eph_dup($line)) {
-				dbg("PCPROT: dup PC16 detected") if isdbg('chanerr');
-				return;
-			}
 			
 			# queue up any messages (look for privates only)
 			DXMsg::queue_msg(1) if $self->state eq 'normal';     
@@ -634,17 +660,17 @@ sub normal
 			my $ncall = $field[2];
 			my $ucall = $field[1];
 
+			if (eph_dup($line)) {
+				dbg("PCPROT: dup PC17 detected") if isdbg('chanerr');
+				return;
+			}
+
 			eph_del_regex("^PC16.*$ncall.*$ucall");
 			
 			if ($ncall eq $main::mycall) {
 				dbg("PCPROT: trying to alter config on this node from outside!") if isdbg('chanerr');
 				return;
 			}
-			$dxchan = DXChannel->get($ncall);
-			if ($dxchan && $dxchan ne $self) {
-				dbg("PCPROT: PC17 from $self->{call} trying to alter locally connected $ncall, ignored!") if isdbg('chanerr');
-				return;
-			}
 
 			my $uref = Route::User::get($ucall);
 			unless ($uref) {
@@ -657,16 +683,17 @@ sub normal
 				return;
 			}			
 
+			$dxchan = $parent->dxchan;
+			if ($dxchan && $dxchan ne $self) {
+				dbg("PCPROT: PC17 from $self->{call} trying to alter locally connected $ncall, ignored!") if isdbg('chanerr');
+				return;
+			}
+
 			# input filter if required
 			return unless $self->in_filter_route($parent);
 			
 			my @rout = $parent->del_user($uref);
 
-			if (eph_dup($line)) {
-				dbg("PCPROT: dup PC17 detected") if isdbg('chanerr');
-				return;
-			}
-
 			$self->route_pc17($parent, @rout) if @rout;
 			return;
 		}
@@ -687,6 +714,11 @@ sub normal
 			my $i;
 			my $newline = "PC19^";
 
+			if (eph_dup($line)) {
+				dbg("PCPROT: dup PC19 detected") if isdbg('chanerr');
+				return;
+			}
+
 			# new routing list
 			my @rout;
 			my $parent = Route::Node::get($self->{call});
@@ -763,10 +795,6 @@ sub normal
 				$user->put;
 			}
 
-			if (eph_dup($line)) {
-				dbg("PCPROT: dup PC19 detected") if isdbg('chanerr');
-				return;
-			}
 
 			$self->route_pc19(@rout) if @rout;
 			return;
@@ -783,6 +811,11 @@ sub normal
 		if ($pcno == 21) {		# delete a cluster from the list
 			my $call = uc $field[1];
 
+			if (eph_dup($line)) {
+				dbg("PCPROT: dup PC21 detected") if isdbg('chanerr');
+				return;
+			}
+
 			eph_del_regex("^PC1[79].*$call");
 			
 			my @rout;
@@ -792,14 +825,21 @@ sub normal
 				$self->disconnect;
 				return;
 			}
-			my $node = Route::Node::get($call);
 			if ($call ne $main::mycall) { # don't allow malicious buggers to disconnect me!
 				if ($call eq $self->{call}) {
 					dbg("PCPROT: Trying to disconnect myself with PC21") if isdbg('chanerr');
 					return;
 				}
 
+				my $node = Route::Node::get($call);
 				if ($node) {
+
+					my $dxchan = $node->dxchan;
+					if ($dxchan && $dxchan ne $self) {
+						dbg("PCPROT: PC21 from $self->{call} trying to alter locally connected $call, ignored!") if isdbg('chanerr');
+						return;
+					}
+
 					# input filter it
 					return unless $self->in_filter_route($node);
 
@@ -811,11 +851,6 @@ sub normal
 				return;
 			}
 
-			if (eph_dup($line)) {
-				dbg("PCPROT: dup PC21 detected") if isdbg('chanerr');
-				return;
-			}
-
 			$self->route_pc21(@rout) if @rout;
 			return;
 		}
@@ -836,6 +871,8 @@ sub normal
 				}
 			}
 
+			return if $rspfcheck and !$self->rspfcheck(1, $field[8], $field[7]);
+
 			# do some de-duping
 			my $d = cltounix($field[1], sprintf("%02d18Z", $field[2]));
 			my $sfi = unpad($field[3]);
@@ -920,6 +957,7 @@ sub normal
 		}
 
 		if (($pcno >= 28 && $pcno <= 33) || $pcno == 40 || $pcno == 42 || $pcno == 49) { # mail/file handling
+			return if $pcno == 49 && eph_dup($line);
 			if ($pcno == 49 || $field[1] eq $main::mycall) {
 				DXMsg::process($self, $line);
 			} else {
@@ -961,7 +999,7 @@ sub normal
 #			my $ref = Route::get($call) || Route->new($call);
 #			return unless $self->in_filter_route($ref);
 
-			if ($field[3] eq $field[2]) {
+			if ($field[3] eq $field[2] || $field[3] =~ /^\s*$/) {
 				dbg('PCPROT: invalid value') if isdbg('chanerr');
 				return;
 			}
@@ -1153,7 +1191,7 @@ sub normal
 		dbg("PCPROT: Ephemeral dup, dropped") if isdbg('chanerr');
 	} else {
 		unless ($self->{isolate}) {
-			broadcast_ak1a($line, $self); # send it to everyone but me
+			DXChannel::broadcast_nodes($line, $self); # send it to everyone but me
 		}
 	}
 }
@@ -1171,14 +1209,14 @@ sub process
 	
 	# send out a pc50 on EVERY channel all at once
 	if ($t >= $last_pc50 + $DXProt::pc50_interval) {
-		$pc50s = pc50($me, scalar DXChannel::get_all_users);
+		$pc50s = pc50($main::me, scalar DXChannel::get_all_users);
 		eph_dup($pc50s);
 		$last_pc50 = $t;
 	}
 
 	foreach $dxchan (@dxchan) {
 		next unless $dxchan->is_node();
-		next if $dxchan == $me;
+		next if $dxchan == $main::me;
 
 		# send the pc50
 		$dxchan->send($pc50s) if $pc50s;
@@ -1227,7 +1265,7 @@ sub send_dx_spot
 	# 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
 	foreach $dxchan (@dxchan) {
-		next if $dxchan == $me;
+		next if $dxchan == $main::me;
 		next if $dxchan == $self && $self->is_node;
 		$dxchan->dx_spot($line, $self->{isolate}, @_, $self->{call});
 	}
@@ -1290,7 +1328,7 @@ sub send_wwv_spot
 	# 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
 	foreach $dxchan (@dxchan) {
-		next if $dxchan == $me;
+		next if $dxchan == $main::me;
 		next if $dxchan == $self && $self->is_node;
 		my $routeit;
 		my ($filter, $hops);
@@ -1337,7 +1375,7 @@ sub send_wcy_spot
 	# 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
 	foreach $dxchan (@dxchan) {
-		next if $dxchan == $me;
+		next if $dxchan == $main::me;
 		next if $dxchan == $self;
 
 		$dxchan->wcy($line, $self->{isolate}, @_, $self->{call}, $wcy_dxcc, $wcy_itu, $wcy_cq, $org_dxcc, $org_itu, $org_cq);
@@ -1414,7 +1452,7 @@ sub send_announce
 	# 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
 	foreach $dxchan (@dxchan) {
-		next if $dxchan == $me;
+		next if $dxchan == $main::me;
 		next if $dxchan == $self && $self->is_node;
 		$dxchan->announce($line, $self->{isolate}, $to, $target, $text, @_, $self->{call}, $ann_dxcc, $ann_itu, $ann_cq, $org_dxcc, $org_itu, $org_cq);
 	}
@@ -1507,103 +1545,13 @@ sub route
 	if ($dxchan) {
 		my $routeit = adjust_hops($dxchan, $line);   # adjust its hop count by node name
 		if ($routeit) {
-			$dxchan->send($routeit) unless $dxchan == $me;
+			$dxchan->send($routeit) unless $dxchan == $main::me;
 		}
 	} else {
 		dbg("PCPROT: No route available, dropped") if isdbg('chanerr');
 	}
 }
 
-# broadcast a message to all clusters taking into account isolation
-# [except those mentioned after buffer]
-sub broadcast_ak1a
-{
-	my $s = shift;				# the line to be rebroadcast
-	my @except = @_;			# to all channels EXCEPT these (dxchannel refs)
-	my @dxchan = DXChannel::get_all_nodes();
-	my $dxchan;
-	
-	# send it if it isn't the except list and isn't isolated and still has a hop count
-	foreach $dxchan (@dxchan) {
-		next if grep $dxchan == $_, @except;
-		next if $dxchan == $me;
-		
-		my $routeit = adjust_hops($dxchan, $s);      # adjust its hop count by node name
-		$dxchan->send($routeit) unless $dxchan->{isolate} || !$routeit;
-	}
-}
-
-# broadcast a message to all clusters ignoring isolation
-# [except those mentioned after buffer]
-sub broadcast_all_ak1a
-{
-	my $s = shift;				# the line to be rebroadcast
-	my @except = @_;			# to all channels EXCEPT these (dxchannel refs)
-	my @dxchan = DXChannel::get_all_nodes();
-	my $dxchan;
-	
-	# send it if it isn't the except list and isn't isolated and still has a hop count
-	foreach $dxchan (@dxchan) {
-		next if grep $dxchan == $_, @except;
-		next if $dxchan == $me;
-
-		my $routeit = adjust_hops($dxchan, $s);      # adjust its hop count by node name
-		$dxchan->send($routeit);
-	}
-}
-
-# broadcast to all users
-# storing the spot or whatever until it is in a state to receive it
-sub broadcast_users
-{
-	my $s = shift;				# the line to be rebroadcast
-	my $sort = shift;           # the type of transmission
-	my $fref = shift;           # a reference to an object to filter on
-	my @except = @_;			# to all channels EXCEPT these (dxchannel refs)
-	my @dxchan = DXChannel::get_all_users();
-	my $dxchan;
-	my @out;
-	
-	foreach $dxchan (@dxchan) {
-		next if grep $dxchan == $_, @except;
-		push @out, $dxchan;
-	}
-	broadcast_list($s, $sort, $fref, @out);
-}
-
-# broadcast to a list of users
-sub broadcast_list
-{
-	my $s = shift;
-	my $sort = shift;
-	my $fref = shift;
-	my $dxchan;
-	
-	foreach $dxchan (@_) {
-		my $filter = 1;
-		next if $dxchan == $me;
-		
-		if ($sort eq 'dx') {
-		    next unless $dxchan->{dx};
-			($filter) = $dxchan->{spotsfilter}->it(@{$fref}) if ref $fref;
-			next unless $filter;
-		}
-		next if $sort eq 'ann' && !$dxchan->{ann} && $s !~ /^To\s+LOCAL\s+de\s+(?:$main::myalias|$main::mycall)/i;
-		next if $sort eq 'wwv' && !$dxchan->{wwv};
-		next if $sort eq 'wcy' && !$dxchan->{wcy};
-		next if $sort eq 'wx' && !$dxchan->{wx};
-
-		$s =~ s/\a//og unless $dxchan->{beep};
-
-		if ($dxchan->{state} eq 'prompt' || $dxchan->{state} eq 'talk') {
-			$dxchan->send($s);	
-		} else {
-			$dxchan->delay($s);
-		}
-	}
-}
-
-
 #
 # obtain the hops from the list for this callsign and pc no 
 #
@@ -1880,7 +1828,7 @@ sub broadcast_route
 	unless ($self->{isolate}) {
 		foreach $dxchan (@dxchan) {
 			next if $dxchan == $self;
-			next if $dxchan == $me;
+			next if $dxchan == $main::me;
 			$dxchan->send_route($generate, @_);
 		}
 	}