From: Dirk Koopman <djk@tobit.co.uk>
Date: Wed, 20 Mar 2024 15:21:30 +0000 (+0000)
Subject: sort out the filtering system
X-Git-Url: http://dxcluster.org/gitweb/gitweb.cgi?p=spider.git;a=commitdiff_plain;h=6a17c3a3e2f7a72c0d13a93c90a010b753319def

sort out the filtering system

So that finally: filter changes happen immediately without having
to disconnect/reconnect.
---

diff --git a/Changes b/Changes
index 0049d7b0..05c67fbe 100644
--- a/Changes
+++ b/Changes
@@ -1,3 +1,16 @@
+20Mar24======================================================================
+1. Has it really been so long since the last update?
+2. Since forever, mainly because filtering was done very early on in
+   DXSpider's development, clearing a filter needed a disconnect/reconnect
+   cycle from the user/node to activate. Now clearing or changing a filter is
+   immediately effective in the current session. 
+
+   Also things like: 'rej/spot user_default on vhf' will immediately apply 
+   to all users that do not already have some other filter in place. Users
+   can override this by setting a filter. 
+   
+   The Filter system will now show the actual token that a faulty command
+   dislikes.  
 25Mar23=======================================================================
 1. Changed the default of X and Y (in item 2 below) to 27 and 20 respectively.
 24Mar23=======================================================================
diff --git a/cmd/clear/announce.pl b/cmd/clear/announce.pl
index 7e41c475..98fb5b87 100644
--- a/cmd/clear/announce.pl
+++ b/cmd/clear/announce.pl
@@ -8,11 +8,10 @@
 my ($self, $line) = @_;
 my @f = split /\s+/, $line;
 my @out;
-my $dxchan = $self;
 my $sort = 'ann';
 my $flag;
 my $fno = 1;
-my $call = $dxchan->call;
+my $call = $self->call;
 my $f;
 
 if ($self->priv >= 8) {
@@ -31,8 +30,8 @@ if ($self->priv >= 8) {
 
 $fno = shift @f if @f && $f[0] =~ /^\d|all$/;
 
-my $filter = Filter::read_in($sort, $call, $flag);
-Filter::delete($sort, $call, $flag, $fno);
+my $filter =  Filter::read_in($sort, $call, $flag);
+Filter::delete($sort, $call, $flag, $fno, $self);
 $flag = $flag ? "input " : "";
 push @out, $self->msg('filter4', $flag, $sort, $fno, $call);
 return (1, @out);
diff --git a/cmd/clear/rbn.pl b/cmd/clear/rbn.pl
index 4a7222b8..f0ea0ef7 100644
--- a/cmd/clear/rbn.pl
+++ b/cmd/clear/rbn.pl
@@ -8,11 +8,10 @@
 my ($self, $line) = @_;
 my @f = split /\s+/, $line;
 my @out;
-my $dxchan = $self;
 my $sort = 'rbn';
 my $flag;
 my $fno = 1;
-my $call = $dxchan->call;
+my $call = $self->call;
 my $f;
 
 if ($self->priv >= 8) {
@@ -32,7 +31,7 @@ if ($self->priv >= 8) {
 $fno = shift @f if @f && $f[0] =~ /^\d|all$/;
 
 my $filter = Filter::read_in($sort, $call, $flag);
-Filter::delete($sort, $call, $flag, $fno);
+Filter::delete($sort, $call, $flag, $fno, $self);
 $flag = $flag ? "input " : "";
 push @out, $self->msg('filter4', $flag, $sort, $fno, $call);
 return (1, @out);
diff --git a/cmd/clear/route.pl b/cmd/clear/route.pl
index f7ab802a..f74e6474 100644
--- a/cmd/clear/route.pl
+++ b/cmd/clear/route.pl
@@ -8,11 +8,10 @@
 my ($self, $line) = @_;
 my @f = split /\s+/, $line;
 my @out;
-my $dxchan = $self;
 my $sort = 'route';
 my $flag;
 my $fno = 1;
-my $call = $dxchan->call;
+my $call = $self->call;
 my $f;
 
 if ($self->priv >= 8) {
@@ -32,7 +31,7 @@ if ($self->priv >= 8) {
 $fno = shift @f if @f && $f[0] =~ /^\d|all$/;
 
 my $filter = Filter::read_in($sort, $call, $flag);
-Filter::delete($sort, $call, $flag, $fno);
+Filter::delete($sort, $call, $flag, $fno, $self);
 $flag = $flag ? "input " : "";
 push @out, $self->msg('filter4', $flag, $sort, $fno, $call);
 return (1, @out);
diff --git a/cmd/clear/spots.pl b/cmd/clear/spots.pl
index a7aa20af..f630eb54 100644
--- a/cmd/clear/spots.pl
+++ b/cmd/clear/spots.pl
@@ -8,17 +8,16 @@
 my ($self, $line) = @_;
 my @f = split /\s+/, $line;
 my @out;
-my $dxchan = $self;
 my $sort = 'spots';
 my $flag;
 my $fno = 1;
-my $call = $dxchan->call;
+my $call = $self->call;
 my $f;
 
 if ($self->priv >= 8) {
 	if (@f && is_callsign(uc $f[0])) {
 		$f = uc shift @f;
-		my $uref = DXUser::get($f);
+		my $uref = DXUser::get_current($f);
 		$call = $uref->call if $uref;
 	} elsif (@f && lc $f[0] eq 'node_default' || lc $f[0] eq 'user_default') {
 		$call = lc shift @f;
@@ -32,7 +31,7 @@ if ($self->priv >= 8) {
 $fno = shift @f if @f && $f[0] =~ /^\d|all$/;
 
 my $filter = Filter::read_in($sort, $call, $flag);
-Filter::delete($sort, $call, $flag, $fno);
+Filter::delete($sort, $call, $flag, $fno, $self);
 $flag = $flag ? "input " : "";
 push @out, $self->msg('filter4', $flag, $sort, $fno, $call);
 return (1, @out);
diff --git a/cmd/clear/wcy.pl b/cmd/clear/wcy.pl
index 68706046..3a3f2c0d 100644
--- a/cmd/clear/wcy.pl
+++ b/cmd/clear/wcy.pl
@@ -8,11 +8,10 @@
 my ($self, $line) = @_;
 my @f = split /\s+/, $line;
 my @out;
-my $dxchan = $self;
 my $sort = 'wcy';
 my $flag;
 my $fno = 1;
-my $call = $dxchan->call;
+my $call = $self->call;
 my $f;
 
 if ($self->priv >= 8) {
@@ -32,7 +31,7 @@ if ($self->priv >= 8) {
 $fno = shift @f if @f && $f[0] =~ /^\d|all$/;
 
 my $filter = Filter::read_in($sort, $call, $flag);
-Filter::delete($sort, $call, $flag, $fno);
+Filter::delete($sort, $call, $flag, $fno, $self);
 $flag = $flag ? "input " : "";
 push @out, $self->msg('filter4', $flag, $sort, $fno, $call);
 return (1, @out);
diff --git a/cmd/clear/wwv.pl b/cmd/clear/wwv.pl
index 8201eb47..d3682103 100644
--- a/cmd/clear/wwv.pl
+++ b/cmd/clear/wwv.pl
@@ -8,11 +8,10 @@
 my ($self, $line) = @_;
 my @f = split /\s+/, $line;
 my @out;
-my $dxchan = $self;
 my $sort = 'wwv';
 my $flag;
 my $fno = 1;
-my $call = $dxchan->call;
+my $call = $self->call;
 my $f;
 
 if ($self->priv >= 8) {
@@ -32,7 +31,7 @@ if ($self->priv >= 8) {
 $fno = shift @f if @f && $f[0] =~ /^\d|all$/;
 
 my $filter = Filter::read_in($sort, $call, $flag);
-Filter::delete($sort, $call, $flag, $fno);
+Filter::delete($sort, $call, $flag, $fno, $self);
 $flag = $flag ? "input " : "";
 push @out, $self->msg('filter4', $flag, $sort, $fno, $call);
 return (1, @out);
diff --git a/perl/DXChannel.pm b/perl/DXChannel.pm
index ceaaf551..1a98c795 100644
--- a/perl/DXChannel.pm
+++ b/perl/DXChannel.pm
@@ -68,7 +68,7 @@ $count = 0;
 		  enhanced => '5,Enhanced Client,yesno',
 		  errors => '9,Errors',
 		  func => '5,Function',
-		  group => '0,Access Group,parray',# used to create a group of users/nodes for some purpose or other.
+		  group => '0,Access Group,parray',
 		  gtk => '5,Using GTK,yesno',
 		  handle_xml => '9,Handles XML,yesno',
 		  here => '0,Here?,yesno',
@@ -813,6 +813,17 @@ sub isregistered
 	}
 }
 
+# try to replace the in-core version of the dxchan with the one that has been modified with items like filters
+sub replace
+{
+	my $self = shift;
+	my $call = shift;
+	if (ref $self) {
+		$call ||= $self->{call};
+		$channels{$call} = $self; 
+	} 
+}
+
 #no strict;
 sub AUTOLOAD
 {
diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm
index b3718721..64483a07 100644
--- a/perl/DXCommandmode.pm
+++ b/perl/DXCommandmode.pm
@@ -175,25 +175,12 @@ sub start
 	# sort out privilege reduction
 	$self->{priv} = 0 unless $self->{hostname} eq '127.0.0.1' || $self->conn->peerhost eq '127.0.0.1' || $self->{hostname} eq '::1' || $self->conn->{usedpasswd};
 
-	# get the filters
-	my $nossid = $call;
-	$nossid =~ s/-\d+$//;
 	
-	$self->{spotsfilter} = Filter::read_in('spots', $call, 0) 
-		|| Filter::read_in('spots', $nossid, 0)
-			|| Filter::read_in('spots', 'user_default', 0);
-	$self->{wwvfilter} = Filter::read_in('wwv', $call, 0) 
-		|| Filter::read_in('wwv', $nossid, 0) 
-			|| Filter::read_in('wwv', 'user_default', 0);
-	$self->{wcyfilter} = Filter::read_in('wcy', $call, 0) 
-		|| Filter::read_in('wcy', $nossid, 0) 
-			|| Filter::read_in('wcy', 'user_default', 0);
-	$self->{annfilter} = Filter::read_in('ann', $call, 0) 
-		|| Filter::read_in('ann', $nossid, 0) 
-			|| Filter::read_in('ann', 'user_default', 0) ;
-	$self->{rbnfilter} = Filter::read_in('rbn', $call, 0) 
-		|| Filter::read_in('rbn', $nossid, 0)
-		|| Filter::read_in('rbn', 'user_default', 0);
+	Filter::load_dxchan($self, 'spots', 0);
+	Filter::load_dxchan($self, 'wwv', 0);
+	Filter::load_dxchan($self, 'wcy', 0);
+	Filter::load_dxchan($self, 'ann', 0);
+	Filter::load_dxchan($self, 'rbn', 0);
 	
 	# clean up qra locators
 	my $qra = $user->qra;
diff --git a/perl/DXProt.pm b/perl/DXProt.pm
index 9f4f3840..c790eaa9 100644
--- a/perl/DXProt.pm
+++ b/perl/DXProt.pm
@@ -321,21 +321,35 @@ sub start
 	$self->{registered} = 1;
 
 	# get the output filters
-	$self->{spotsfilter} = Filter::read_in('spots', $call, 0) || Filter::read_in('spots', 'node_default', 0);
-	$self->{wwvfilter} = Filter::read_in('wwv', $call, 0) || Filter::read_in('wwv', 'node_default', 0);
-	$self->{wcyfilter} = Filter::read_in('wcy', $call, 0) || Filter::read_in('wcy', 'node_default', 0);
-	$self->{annfilter} = Filter::read_in('ann', $call, 0) || Filter::read_in('ann', 'node_default', 0) ;
-	$self->{routefilter} = Filter::read_in('route', $call, 0) || Filter::read_in('route', 'node_default', 0) unless $self->{isolate};
-	$self->{pc92filter} = Filter::read_in('pc92', $call, 0) || Filter::read_in('pc92', 'node_default', 0) unless $self->{isolate} ;
+#	$self->{spotsfilter} = Filter::read_in('spots', $call, 0) || Filter::read_in('spots', 'node_default', 0);
+#	$self->{wwvfilter} = Filter::read_in('wwv', $call, 0) || Filter::read_in('wwv', 'node_default', 0);
+#	$self->{wcyfilter} = Filter::read_in('wcy', $call, 0) || Filter::read_in('wcy', 'node_default', 0);
+#	$self->{annfilter} = Filter::read_in('ann', $call, 0) || Filter::read_in('ann', 'node_default', 0) ;
+#	$self->{routefilter} = Filter::read_in('route', $call, 0) || Filter::read_in('route', 'node_default', 0) unless $self->{isolate};
+#	$self->{pc92filter} = Filter::read_in('pc92', $call, 0) || Filter::read_in('pc92', 'node_default', 0) unless $self->{isolate} ;
+
+	Filter::load_dxchan($self, 'spots', 0);
+	Filter::load_dxchan($self, 'wwv', 0);
+	Filter::load_dxchan($self, 'wcy', 0);
+	Filter::load_dxchan($self, 'ann', 0);
+	Filter::load_dxchan($self, 'route', 0) unless $self->{isolate};
+	Filter::load_dxchan($self, 'pc92', 0) unless $self->{isolate};
 
 
 	# get the INPUT filters (these only pertain to Clusters)
-	$self->{inspotsfilter} = Filter::read_in('spots', $call, 1) || Filter::read_in('spots', 'node_default', 1);
-	$self->{inwwvfilter} = Filter::read_in('wwv', $call, 1) || Filter::read_in('wwv', 'node_default', 1);
-	$self->{inwcyfilter} = Filter::read_in('wcy', $call, 1) || Filter::read_in('wcy', 'node_default', 1);
-	$self->{inannfilter} = Filter::read_in('ann', $call, 1) || Filter::read_in('ann', 'node_default', 1);
-	$self->{inroutefilter} = Filter::read_in('route', $call, 1) || Filter::read_in('route', 'node_default', 1) unless $self->{isolate};
-	$self->{inpc92filter} = Filter::read_in('pc92', $call, 0) || Filter::read_in('pc92', 'node_default', 0) unless $self->{isolate} ;
+#	$self->{inspotsfilter} = Filter::read_in('spots', $call, 1) || Filter::read_in('spots', 'node_default', 1);
+#	$self->{inwwvfilter} = Filter::read_in('wwv', $call, 1) || Filter::read_in('wwv', 'node_default', 1);
+#	$self->{inwcyfilter} = Filter::read_in('wcy', $call, 1) || Filter::read_in('wcy', 'node_default', 1);
+#	$self->{inannfilter} = Filter::read_in('ann', $call, 1) || Filter::read_in('ann', 'node_default', 1);
+#	$self->{inroutefilter} = Filter::read_in('route', $call, 1) || Filter::read_in('route', 'node_default', 1) unless $self->{isolate};
+#	$self->{inpc92filter} = Filter::read_in('pc92', $call, 0) || Filter::read_in('pc92', 'node_default', 0) unless $self->{isolate} ;
+
+	Filter::load_dxchan($self, 'spots', 1);
+	Filter::load_dxchan($self, 'wwv', 1);
+	Filter::load_dxchan($self, 'wcy', 1);
+	Filter::load_dxchan($self, 'ann', 1);
+	Filter::load_dxchan($self, 'route', 1) unless $self->{isolate};
+	Filter::load_dxchan($self, 'pc92', 1) unless $self->{isolate};
 
 
 	# set unbuffered and no echo
diff --git a/perl/Filter.pm b/perl/Filter.pm
index 10021a4e..4be0b630 100644
--- a/perl/Filter.pm
+++ b/perl/Filter.pm
@@ -327,13 +327,17 @@ sub install
 	my $in = "";
 	$in = "in" if $name =~ s/^IN_//;
 	$name =~ s/.PL$//;
-		
-	my $dxchan;
+	my $nossid = $name;
+	$nossid =~ s/-\d+$//;
+	my $dxchan = shift;
+
 	my @dxchan;
 	if ($name eq 'NODE_DEFAULT') {
 		@dxchan = DXChannel::get_all_nodes();
 	} elsif ($name eq 'USER_DEFAULT') {
 		@dxchan = DXChannel::get_all_users();
+	} elsif ($dxchan) {
+		push @dxchan, $dxchan;
 	} else {
 		$dxchan = DXChannel::get($name);
 		push @dxchan, $dxchan if $dxchan;
@@ -341,16 +345,35 @@ sub install
 	foreach $dxchan (@dxchan) {
 		my $n = "$in$sort" . "filter";
 		my $i = $in ? 'IN_' : '';
-		my $ref = $dxchan->$n();
-		if (!$ref || ($ref && uc $ref->{name} eq "$i$name.PL")) {
-			$dxchan->$n($remove ? undef : $self);
+		if ($remove) {
+			$dxchan->{$n} = undef;
+		}
+		unless ($dxchan->{$n}) {
+			Filter::load_dxchan($dxchan, $sort, $in);
 		}
 	}
 }
 
+# This simply fixes up an existing (or recently modified) Filter into
+# an existing dxchan
+sub load_dxchan
+{
+	my $dxchan = shift;
+	my $sort = lc shift;
+	my $in = shift ? 'in' : '';
+	my $nossid = $dxchan->call;
+	$nossid =~ s/-\d+$//;
+	my $n = "$in$sort" . "filter";
+	
+	$dxchan->{$n} =
+		Filter::read_in($sort, $dxchan->call,  $in)	||
+			Filter::read_in($sort, $nossid,  $in) ||
+				Filter::read_in($sort, $dxchan->is_user ? 'user_default' : 'node_default', $in);
+}
+
 sub delete
 {
-	my ($sort, $call, $flag, $fno) = @_;
+	my ($sort, $call, $flag, $fno, $dxchan) = @_;
 	
 	# look for the file
 	my $fn = getfn($sort, $call, $flag);
@@ -361,17 +384,18 @@ sub delete
 			foreach $key ($filter->getfilkeys) {
 				delete $filter->{$key};
 			}
+			delete $filter->{getfilkeys};
 		} elsif (exists $filter->{"filter$fno"}) {
 			delete $filter->{"filter$fno"}; 
 		}
 		
 		# get rid 
 		if ($filter->{hops} || $filter->getfilkeys) {
-			$filter->install;
 			$filter->write;
+			Filter::load_dxchan($dxchan, $sort, $in);
 		} else {
-			$filter->install(1);
 			unlink $fn;
+			$filter->install(1, $dxchan);
 		}
 	}
 }
@@ -557,7 +581,7 @@ sub parse
 						last;
 					}
 				}
-				return (1, $dxchan->msg('e20', $lasttok)) unless $found;
+				return (1, $dxchan->msg('e20', $tok)) unless $found;
 			} else {
 				$s = $tok =~ /^{.*}$/ ? '{' . decode_regex($tok) . '}' : $tok;
 				return (1, $dxchan->msg('filter2', $s));
@@ -566,7 +590,7 @@ sub parse
 		}
 	}
 
-	# tidy up the user string (why I have to stick in an if statement when I have initialised it I have no idea! 5.28 bug?
+	# tidy up the user string (why I have to stick in an if statement when I have initialised it I have no idea! 5.28 bug)?
 	if ($user) {
 		$user =~ s/\)\s*\(/ and /g;
 		$user =~ s/\&\&/ and /g;
diff --git a/perl/Msg.pm b/perl/Msg.pm
index c81273e2..490ea046 100644
--- a/perl/Msg.pm
+++ b/perl/Msg.pm
@@ -585,7 +585,6 @@ sub DESTROY
 		dbgtrace((ref $conn) . "::DESTROY on call $call called from ${pkg}::${fn} line $line ");
 	}
 
-	my $call = $conn->{call} || 'unallocated';
 	my $host = $conn->{peerhost} || '';
 	my $port = $conn->{peerport} || '';
 	my $sock = $conn->{sock};
diff --git a/perl/RBN.pm b/perl/RBN.pm
index 820f39cb..4c285753 100644
--- a/perl/RBN.pm
+++ b/perl/RBN.pm
@@ -202,11 +202,10 @@ sub start
 	$self->{priv} = 0;
 
 	# get the filters
-	my $nossid = $call;
-	$nossid =~ s/-\d+$//;
+#	$self->{inrbnfilter} = Filter::read_in('rbn', $call, 1) 
+#		|| Filter::read_in('rbn', 'node_default', 1);
 
-	$self->{inrbnfilter} = Filter::read_in('rbn', $call, 1) 
-		|| Filter::read_in('rbn', 'node_default', 1);
+	Filter::load_dxchan($self, 'rbn', 1);
 	
 	# clean up qra locators
 	my $qra = $user->qra;
diff --git a/perl/console.pl b/perl/console.pl
index 3258af44..b919d076 100755
--- a/perl/console.pl
+++ b/perl/console.pl
@@ -29,12 +29,16 @@ our $foreground;
 our $background;
 our $mycallcolor;
 our @colors;
+our $data;
+our $local_data;
 
 # search local then perl directories
 BEGIN {
 	# root of directory tree for this system
 	$root = "/spider"; 
 	$root = $ENV{'DXSPIDER_ROOT'} if $ENV{'DXSPIDER_ROOT'};
+	$local_data = "$root/local_data";
+	$data = "$root/data";
 	
 	unshift @INC, "$root/perl";	# this IS the right way round!
 	unshift @INC, "$root/local";