From: Dirk Koopman <djk@tobit.co.uk>
Date: Mon, 3 Feb 2025 16:52:20 +0000 (+0000)
Subject: mprove Filter debgging
X-Git-Url: http://gb7djk.dxcluster.net/gitweb/gitweb.cgi?a=commitdiff_plain;h=23a4ed0ae965063c4e8aa9395c574777b612ab52;p=spider.git

mprove Filter debgging
---

diff --git a/Changes b/Changes
index 3c52892d..9235a747 100644
--- a/Changes
+++ b/Changes
@@ -1,3 +1,20 @@
+03Jan25======================================================================
+1. Filter cleanup (especially filter debugging)
+31Jan25======================================================================
+1. Fixed botched node link initialisation check. This what prevent ann/full
+   working and would have stopped talk, rcmd etc etc. 
+2. Added a field called 'state' to the who command to allow sysops to
+   diagnose some connection initialisation problems. 
+3. Add some callsigns to badnode/badspotter callsigns in debug messages.
+29Jan25======================================================================
+1. Fix dx command <cough>. "I never changed that bit". If I had this would
+   never have happened. 
+2. Fixed another fix that was to do with deduping and thus cause locally 
+   generated spots to be stored in the local spot files again. 
+3. Made an attempt to allow perl regex filter statements to work on callsigns
+   as well comments and other text fields. This means that:
+       reject/spot call {wwa$} or info {w\s*\w\*a} 
+   will likely reduce your spots considerably.  
 28Jan25======================================================================
 1. Set default Spot qrg granularity to 1KHz (was 25KHz).
 2. Refine Incoming CCLuster connection handling. It is a requirement that a
diff --git a/perl/DXProt.pm b/perl/DXProt.pm
index c790eaa9..f1588c8a 100644
--- a/perl/DXProt.pm
+++ b/perl/DXProt.pm
@@ -1475,7 +1475,7 @@ sub send_route
 				if ($filter) {
 					push @rin, $r;
 				} else {
-					dbg("PCPROT: $self->{call}/" . $r->call . " rejected by output filter") if isdbg('filter');
+					dbg("PCPROT: send_route $self->{call}/" . $r->call . " rejected by output filter") if isdbg('filter');
 				}
 			} else {
 				dbg("was sent a null value") if isdbg('chanerr');
diff --git a/perl/DXProtHandle.pm b/perl/DXProtHandle.pm
index ae6e7f86..77db15e3 100644
--- a/perl/DXProtHandle.pm
+++ b/perl/DXProtHandle.pm
@@ -113,7 +113,7 @@ sub handle_10
 	# if this is a 'nodx' node then ignore it
 	if ($badnode->in($pc->[6]) || ($via && $badnode->in($via))) {
 		dbg($line) if isdbg('nologchan');
-		dbg("PCPROT: Bad Node, dropped");
+		dbg("PCPROT: Bad Node $pc->[6]/$via, dropped");
 		return;
 	}
 
@@ -122,7 +122,7 @@ sub handle_10
 	$nossid =~ s/-\d+$//;
 	if ($badspotter->in($nossid)) {
 		dbg($line) if isdbg('nologchan');
-		dbg("PCPROT: Bad Spotter, dropped");
+		dbg("PCPROT: Bad Spotter $nossid, dropped");
 		return;
 	}
 
@@ -256,7 +256,7 @@ sub handle_11
 	# is this is a 'bad spotter' or an unknown user then ignore it. 
 	if ($badspotter->in($nossid)) {
 		dbg($line) if isdbg('nologchan');
-		dbg("PCPROT: Bad Spotter $pc->[6], dropped");
+		dbg("PCPROT: Bad Spotter $nossid, dropped");
 		return;
 	}
 
@@ -594,7 +594,7 @@ sub handle_12
 	# if this is a 'nodx' node then ignore it
 	if ($badnode->in($pc->[5])) {
 		dbg($line) if isdbg('nologchan');
-		dbg("PCPROT: Bad Node, dropped");
+		dbg("PCPROT: Bad Node $pc->[5], dropped");
 		return;
 	}
 
@@ -603,7 +603,7 @@ sub handle_12
 	$nossid =~ s/-\d+$//;
 	if ($badspotter->in($nossid)) {
 		dbg($line) if isdbg('nologchan');
-		dbg("PCPROT: Bad Spotter, dropped");
+		dbg("PCPROT: Bad Spotter $nossid, dropped");
 		return;
 	}
 
@@ -2521,7 +2521,7 @@ sub handle_93
 	$nossid =~ s/-\d+$//;
 	if ($badspotter->in($nossid)) {
 		dbg($line) if isdbg('nologchan');
-		dbg("PCPROT: Bad Spotter, dropped");
+		dbg("PCPROT: Bad Spotter $nossid, dropped");
 		return;
 	}
 
diff --git a/perl/Filter.pm b/perl/Filter.pm
index 1c6b8589..53b7d64b 100644
--- a/perl/Filter.pm
+++ b/perl/Filter.pm
@@ -251,8 +251,14 @@ sub it
 	my $key;
 	my $type = 'Dunno';
 	my $asc = '?';
+	
+	my $r = 1;
+	my $reason = '';
+	
+	my $hit = undef;
+	my $true = 'PASS';
+   
 
-	my $r = @keys > 0 ? 0 : 1;
 	foreach $key (@keys) {
 		$filter = $self->{$key};
 		if ($filter->{reject} && exists $filter->{reject}->{code}) {
@@ -260,8 +266,12 @@ sub it
 			$asc = $filter->{reject}->{user};
 			if (&{$filter->{reject}->{code}}(ref $_[0] ? $_[0] : \@_)) {
 				$r = 0;
+				$true = 'REJ ';
+				$hit = $filter->{reject};
+				$reason = $hit->{user};
 				last;
 			} else {
+				$true = 'OK ';
 				$r = 1;
 			}		
 		}
@@ -270,11 +280,15 @@ sub it
 			$asc = $filter->{accept}->{user};
 			if (&{$filter->{accept}->{code}}(ref $_[0] ? $_[0] : \@_)) {
 				$r = 1;
+				$true = 'ACC ';
+				$hit = $filter->{accept};
+				$reason = $hit->{user};
 				last;
 			} else {
+				$true = 'OK ';
 				$r = 0;
 			}			
-		} 
+		}
 	}
 
 	# hops are done differently (simply) 
@@ -282,14 +296,17 @@ sub it
 
 	if (isdbg('filter')) {
 		my $call = $self->{name};
-		my $args = join '\',\'', map {defined $_ ? $_ : 'undef'} (ref $_[0] ? @{$_[0]} : @_);
-		my $true = $r ? "OK " : "REJ";
+		my $args = join ', ', map {defined $_ ? $_ : 'undef'} (ref $_[0] ? @{$_[0]} : @_);
 		my $sort = $self->{sort};
 		my $dir = $self->{name} =~ /^in_/i ? "IN " : "OUT";
 
 		$call =~ s/\.PL$//i;
-		my $h = $hops || '';
-		dbg("Filter: $call $true $dir: $type/$sort with '$asc' on '$args' $h") if isdbg('filter');
+		my $h = " hops: $hops" || '';
+		if ($reason) {
+			dbg("Filter: $call $true $dir $type/$sort '$reason' on '$args'") if isdbg('filter');
+		} else {
+			dbg("Filter: $call $true $dir on '$args'") if isdbg('filter');
+		}
 	}
 	return ($r, $hops);
 }