sort out the filtering system

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

diff --git a/Changes b/Changes
index 0049d7b06d630e039ead7aa9c1ec4d2f7f798405..05c67fbe4efff15add7ce075b4a3033888e990b6 100644 (file)
--- 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 7e41c475b80e2f0ee0a010add1d7e3011d5bdbed..98fb5b873104f040ea812bee4ae09c391457509c 100644 (file)
--- 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 4a7222b861dd01e11bb0b338cc9200cc195faf57..f0ea0ef745e59ada18cf8f86ef5f59f8841c5bcb 100644 (file)
--- 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 f7ab802a5fe72f1e8f9e04ef79d6628604d8b218..f74e6474b1cd0467435b936aaeabfd0ee1a43534 100644 (file)
--- 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 a7aa20af36bacfe054b3b66a17dfd7c66e8b637c..f630eb54c914718a2504b99d7c9eefbd00600734 100644 (file)
--- 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 68706046182f0f74a7466f6ac5d14b3eab98b0b8..3a3f2c0d28d67179fe03a352672348c2c440e564 100644 (file)
--- 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 8201eb47ec020b4ba3b462e5035f4d5e8a6dddbd..d3682103b6a7e410c15f29de242908636c387729 100644 (file)
--- 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 ceaaf551907c0b8aaee3e19a55737c58bf92df6f..1a98c7950ad906c1e99541515bb47ac61aaa3a0c 100644 (file)
--- 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 b3718721c69a843fe947c8a06d0725f0f36c37dc..64483a07407cd3ced942d7d248d63feae0f4c8f1 100644 (file)
--- 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 9f4f3840242adaa38085bf34c7a01f815a7392ba..c790eaa95afc96adc6ad852fdef3e704cb986a8b 100644 (file)
--- 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 10021a4eada0e886660e65b44e699451bd8fb452..4be0b630fbdbbb8072ed6f1a7d370fe54c516e0e 100644 (file)
--- 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 c81273e29b329a5070b2bd53e34e7371564e3c68..490ea04604f4e96293c47bd68a1854bac3f78203 100644 (file)
--- 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 820f39cbb620d73cab33efaa54da2245edef0876..4c28575365fee363b478e5cce3fcbd4c1e338ee4 100644 (file)
--- 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 3258af44ffb1441b734146b5bee5c7d58a8b4a5c..b919d07660cf9ca95d7abf13bee2fb64b8027659 100755 (executable)
--- 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";