added DXHash.pm
authorminima <minima>
Tue, 9 Jan 2001 00:59:39 +0000 (00:59 +0000)
committerminima <minima>
Tue, 9 Jan 2001 00:59:39 +0000 (00:59 +0000)
added/changed set/unset/show baddx badspotter badnode

16 files changed:
Changes
cmd/Commands_en.hlp
cmd/set/baddx.pl [new file with mode: 0644]
cmd/set/badnode.pl
cmd/set/badspotter.pl [new file with mode: 0644]
cmd/show/baddx.pl [new file with mode: 0644]
cmd/show/badnode.pl
cmd/show/badspotter.pl [new file with mode: 0644]
cmd/unset/baddx.pl [new file with mode: 0644]
cmd/unset/badnode.pl
cmd/unset/badspotter.pl [new file with mode: 0644]
data/baddx.pl.issue [deleted file]
perl/DXHash.pm [new file with mode: 0644]
perl/DXMsg.pm
perl/DXProt.pm
perl/Messages

diff --git a/Changes b/Changes
index c2039fb69624868000712a145edff4e67ffd0e0a..a0b271e7a1ab7dd857eeaacc9171218d2d3a3e0b 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,3 +1,9 @@
+08Jan01=======================================================================
+1. Changed the way that badnodes, badmsg etc work. There is a new general way
+implemented (dunno why I didn't do this before - hey ho...) as a consequence
+there are set/unset/show baddx (for bad dx callsigns) badnode (for dx from
+bad nodes) badspotter (for bad spotters of dx eg VE2STN). Expect more of 
+this sort of thing...
 06Jan01=======================================================================
 1. Fix set/obscount so it actually works.
 2. Allow different number formats for set/pingint eg: 5m for 5 minutes and
index 1cd2b30f664ff0087f2b66b97b19cecd01400ee3..dbfa1770083c46529e9c00a20539b605fedcc002 100644 (file)
@@ -607,11 +607,6 @@ running in order for the changes to take effect.
 Reload the /spider/data/bands.pl file if you have changed it manually whilst
 the cluster is running. 
 
-=== 9^LOAD/BADDX^Reload the bad DX table
-Reload the /spider/data/baddx.pl file if you have changed it manually whilst
-the cluster is running. This table contains the DX Calls that, if spotted, 
-will not be passed on. FR0G and TEST are classic examples.
-
 === 9^LOAD/BADMSG^Reload the bad msg table
 Reload the /spider/msg/badmsg.pl file if you have changed it manually whilst
 the cluster is running. This table contains a number of perl regular 
@@ -931,17 +926,32 @@ SP is an alias for SEND PRIVATE
 
 === 5^SET/ARCLUSTER <call> [<call>..]^Make the callsign an AR-Cluster node
 
-=== 6^SET/BADNODE <call>^Stop spots from this callsign being propagated
-=== 6^UNSET/BADNODE <call>^Allow spots from this callsign again
+=== 8^SET/BADDX <call>..^Stop spots for this callsign being propagated
+=== 8^UNSET/BADDX <call>..^Allow spots for this callsign again
+Setting a callsign as a 'baddx' will prevent spots of this callsign 
+going any further. They will not be displayed and they will not be 
+sent onto other nodes.
+
+The call must be a full eg:-
+
+  set/baddx FORSALE VIDEO FR0G 
+
+  unset/badnode VIDEO
+
+will allow spots to that callsign again.
+
+=== 8^SET/BADNODE <call>..^Stop spots from this node being propagated
+=== 8^UNSET/BADNODE <call>..^Allow spots from this node again
 Setting a callsign as a 'badnode' will prevent spots from that node 
 going any further. They will not be displayed and they will not be 
 sent onto other nodes.
 
-The call can be a full or partial call (or a prefix), eg:-
+The call must be a full eg:-
 
   set/badnode K1TTT 
 
-will stop anything from K1TTT (including any SSID's)
+will stop anything from K1TTT. If you want SSIDs as well then you must
+enter them specifically.
 
   unset/badnode K1TTT
 
@@ -949,6 +959,25 @@ will allow spots from him again.
 
 Use with extreme care. This command may well be superceeded by FILTERing.
 
+=== 8^SET/BADSPOTTER <call>..^Stop spots from this callsign being propagated
+=== 8^UNSET/BADSPOTTER <call>..^Allow spots from this callsign again
+Setting a callsign as a 'badspotter' will prevent spots from this callsign 
+going any further. They will not be displayed and they will not be 
+sent onto other nodes.
+
+The call must be a full eg:-
+
+  set/badspotter VE2STN 
+
+will stop anything from VE2STN. If you want SSIDs as well then you must
+enter them specifically.
+
+  unset/badnode VE2STN
+
+will allow spots from him again.
+
+Use with extreme care. This command may well be superceeded by FILTERing.
+
 === 0^SET/BEEP^Add a beep to DX and other messages on your terminal
 === 0^UNSET/BEEP^Stop beeps for DX and other messages on your terminal
 
@@ -1142,10 +1171,18 @@ Tell the system where you are. For example:-
 === 0^SET/WX^Allow WX messages to come out on your terminal
 === 0^UNSET/WX^Stop WX messages coming out on your terminal
 
-=== 6^SHOW/BADNODE^Show all the bad nodes in the system
+=== 1^SHOW/BADDX^Show all the bad dx calls in the system
+Display all the bad dx callsigns in the system, see SET/BADDX
+for more information.
+
+=== 1^SHOW/BADNODE^Show all the bad nodes in the system
 Display all the bad node callsigns in the system, see SET/BADNODE
 for more information.
 
+=== 1^SHOW/BADSPOTTER^Show all the bad spotters in the system
+Display all the bad spotter's callsigns in the system, see SET/BADSPOTTER
+for more information.
+
 === 0^SHOW/DATE [<prefix>|<callsign>]^Show the local time 
 This is very nearly the same as SHOW/TIME, the only difference the format
 of the date string if no arguments are given.
diff --git a/cmd/set/baddx.pl b/cmd/set/baddx.pl
new file mode 100644 (file)
index 0000000..748640e
--- /dev/null
@@ -0,0 +1,10 @@
+#
+# set list of bad dx callsigns
+#
+# Copyright (c) 1998 - Dirk Koopman G1TLH
+#
+# $Id$
+#
+my ($self, $line) = @_;
+return $DXProt::baddx->set(8, $self->msg('e6'), $self, $line);
+
index 8af48111dbb8e4fb374bf52f6a79595aef826a7b..bcd4679cf3a9c997282fff497ce19216529cb2be 100644 (file)
@@ -1,18 +1,10 @@
 #
-# set list of bad nodes
+# set list of bad dx nodes
 #
 # Copyright (c) 1998 - Dirk Koopman G1TLH
 #
 # $Id$
 #
 my ($self, $line) = @_;
-return (1, $self->msg('e5')) if $self->priv < 6;
-my @f = split /\s+/, $line;
-my @out;
-for (@f) {
-       return (1, $self->msg('e19')) if /[^\s\w_\-\/]/;
-       my $call = uc $_;
-       push @DXProt::nodx_node, $call;
-       push @out, $self->msg('badnode1', $call);
-}
-return (1, @out);
+return $DXProt::badnode->set(8, $self->msg('e12'), $self, $line);
+
diff --git a/cmd/set/badspotter.pl b/cmd/set/badspotter.pl
new file mode 100644 (file)
index 0000000..6478c6f
--- /dev/null
@@ -0,0 +1,10 @@
+#
+# set list of bad dx spotters
+#
+# Copyright (c) 1998 - Dirk Koopman G1TLH
+#
+# $Id$
+#
+my ($self, $line) = @_;
+return $DXProt::badspotter->set(8, $self->msg('e6'), $self, $line);
+
diff --git a/cmd/show/baddx.pl b/cmd/show/baddx.pl
new file mode 100644 (file)
index 0000000..6e8718c
--- /dev/null
@@ -0,0 +1,10 @@
+#
+# show list of bad dx callsigns
+#
+# Copyright (c) 1998 - Dirk Koopman G1TLH
+#
+# $Id$
+#
+my ($self, $line) = @_;
+return $DXProt::baddx->show(1, $self);
+
index ff59c68deab622c2d8efe5aafab1d870b2231523..cbfa5047eccb96b061bc8d159a5c2e57990e27d8 100644 (file)
@@ -1,14 +1,10 @@
 #
-# show list of bad nodes
+# show list of bad dx nodes
 #
 # Copyright (c) 1998 - Dirk Koopman G1TLH
 #
 # $Id$
 #
 my ($self, $line) = @_;
-return (1, $self->msg('e5')) if $self->priv < 6;
-my @out = ($self->msg('badnode3'));
-for (@DXProt::nodx_node) {
-       push @out,  $_;
-}
-return (1, @out);
+return $DXProt::badnode->show(1, $self);
+
diff --git a/cmd/show/badspotter.pl b/cmd/show/badspotter.pl
new file mode 100644 (file)
index 0000000..1110a0b
--- /dev/null
@@ -0,0 +1,10 @@
+#
+# show list of bad spotter callsigns
+#
+# Copyright (c) 1998 - Dirk Koopman G1TLH
+#
+# $Id$
+#
+my ($self, $line) = @_;
+return $DXProt::badspotter->show(1, $self);
+
diff --git a/cmd/unset/baddx.pl b/cmd/unset/baddx.pl
new file mode 100644 (file)
index 0000000..e979872
--- /dev/null
@@ -0,0 +1,10 @@
+#
+# unset list of bad dx callsigns
+#
+# Copyright (c) 1998 - Dirk Koopman G1TLH
+#
+# $Id$
+#
+my ($self, $line) = @_;
+return $DXProt::baddx->unset(8, $self->msg('e6'), $self, $line);
+
index 4e42e28d530690e8f41c29c3e71cf2aa712521c3..65d105274f6fabc51760c25734ba8ae532129c91 100644 (file)
@@ -1,18 +1,10 @@
 #
-# unset list of bad nodes
+# set list of bad dx nodes
 #
 # Copyright (c) 1998 - Dirk Koopman G1TLH
 #
 # $Id$
 #
 my ($self, $line) = @_;
-return (1, $self->msg('e5')) if $self->priv < 6;
-my @f = split /\s+/, $line;
-my @out;
-for (@f) {
-       return (1, $self->msg('e19')) if /[^\s\w_\-\/]/;
-       my $call = uc $_;
-       @DXProt::nodx_node = grep { !$call =~ /^$_/ } @DXProt::nodx_node;
-       push @out, $self->msg('badnode2', $call);
-}
-return (1, @out);
+return $DXProt::badnode->unset(8, $self->msg('e12'), $self, $line);
+
diff --git a/cmd/unset/badspotter.pl b/cmd/unset/badspotter.pl
new file mode 100644 (file)
index 0000000..5664f1c
--- /dev/null
@@ -0,0 +1,10 @@
+#
+# set list of bad dx spotters
+#
+# Copyright (c) 1998 - Dirk Koopman G1TLH
+#
+# $Id$
+#
+my ($self, $line) = @_;
+return $DXProt::badspotter->unset(8, $self->msg('e6'), $self, $line);
+
diff --git a/data/baddx.pl.issue b/data/baddx.pl.issue
deleted file mode 100644 (file)
index 55dfe0c..0000000
+++ /dev/null
@@ -1,19 +0,0 @@
-#
-# the list of dx spot addresses that we don't store and don't pass on
-#
-
-package DXProt;
-
-@baddx = qw 
-(
- FROG 
- SALE
- FORSALE
- WANTED
- P1RATE
- PIRATE
- TEST
- DXTEST
- NIL
- NOCALL 
-);
diff --git a/perl/DXHash.pm b/perl/DXHash.pm
new file mode 100644 (file)
index 0000000..b97d54c
--- /dev/null
@@ -0,0 +1,127 @@
+#
+# a class for setting 'bad' (or good) things
+#
+# This is really a general purpose list handling 
+# thingy for determining good or bad objects like
+# callsigns. It is for storing things "For Ever".
+#
+# Things entered into the list are always upper
+# cased.
+# 
+# The files that are created live in /spider/data
+# 
+# Dunno why I didn't do this earlier but heyho..
+#
+# Copyright (c) 2001 Dirk Koopman G1TLH
+#
+# $Id$
+#
+
+package DXHash;
+
+use DXVars;
+use DXUtil;
+use DXDebug;
+
+use strict;
+
+sub new
+{
+       my ($pkg, $name) = @_;
+       my $s = readfilestr($main::data, $name);
+       my $self = eval $s;
+       dbg('err', "error in reading $name in DXHash $@") if $@;
+       $self = bless {name => $name}, $pkg unless $self;
+       return $self;
+}
+
+sub put
+{
+       my $self = shift;
+       writefilestr($main::data, $self->{name}, undef, $self);
+}
+
+sub add
+{
+       my $self = shift;
+       my $n = uc shift;
+       my $t = shift || time;
+       $self->{$n} = $t;
+}
+
+sub del
+{
+       my $self = shift;
+       my $n = uc shift;
+       delete $self->{$n};
+}
+
+sub in
+{
+       my $self = shift;
+       my $n = uc shift;
+       return exists $self->{$n};
+}
+
+# this is really just a general shortcut for all commands to
+# set and unset values 
+sub set
+{
+       my ($self, $priv, $noline, $dxchan, $line) = @_;
+       return (1, $dxchan->msg('e5')) unless $dxchan->priv >= $priv;
+       my @f = split /\s+/, $line;
+       return (1, $noline) unless @f;
+       my $f;
+       my @out;
+       
+       foreach $f (@f) {
+
+               if ($self->in($f)) {
+                       push @out, $dxchan->msg('hasha',uc $f, $self->{name});
+                       next;
+               }
+               $self->add($f);
+               push @out, $dxchan->msg('hashb', uc $f, $self->{name});
+       }
+       $self->put;
+       return (1, @out);
+}
+
+# this is really just a general shortcut for all commands to
+# set and unset values 
+sub unset
+{
+       my ($self, $priv, $noline, $dxchan, $line) = @_;
+       return (1, $dxchan->msg('e5')) unless $dxchan->priv >= $priv;
+       my @f = split /\s+/, $line;
+       return (1, $noline) unless @f;
+       my $f;
+       my @out;
+       
+       foreach $f (@f) {
+
+               unless ($self->in($f)) {
+                       push @out, $dxchan->msg('hashd', uc $f, $self->{name});
+                       next;
+               }
+               $self->del($f);
+               push @out, $dxchan->msg('hashc', uc $f, $self->{name});
+       }
+       $self->put;
+       return (1, @out);
+}
+
+sub show
+{
+       my ($self, $priv, $dxchan) = @_;
+       return (1, $dxchan->msg('e5')) unless $dxchan->priv >= $priv;
+       
+       my @out;
+       for (sort keys %{$self}) {
+               next if $_ eq 'name';
+               push @out, $dxchan->msg('hashe', $_, cldatetime($self->{$_}));
+       }
+       return (1, @out);
+}
+
+1;
index 501d137d1454ba49bdc971312cffbfd39c1bc0c8..c91049ab19de50f9fb3b871d5a93520a43e1085d 100644 (file)
@@ -287,8 +287,7 @@ sub process
                                                $ref->swop_it($self->call);
                                                
                                                # look for 'bad' to addresses 
-#                                              if (grep $ref->{to} eq $_, @badmsg) {
-                                               if ($ref->dump_it($self->call)) {
+                                               if ($ref->dump_it) {
                                                        $ref->stop_msg($self->call);
                                                        dbg('msg', "'Bad' message $ref->{to}");
                                                        Log('msg', "'Bad' message $ref->{to}");
@@ -761,7 +760,7 @@ sub init
                }
                
                # delete any messages to 'badmsg.pl' places
-               if (grep $ref->{to} eq $_, @badmsg) {
+               if ($ref->dump_it) {
                        dbg('msg', "'Bad' TO address $ref->{to}");
                        Log('msg', "'Bad' TO address $ref->{to}");
                        $ref->del_msg;
@@ -976,7 +975,6 @@ sub forward_it
 sub dump_it
 {
        my $ref = shift;
-       my $call = shift;
        my $i;
        
        for ($i = 0; $i < @badmsg; $i += 3) {
index af94ecac44a4e0e143e155d0c0987da0d5c20ffd..f03a610327cdccf0c77e361ce6c77868ff70b99e 100644 (file)
@@ -30,11 +30,12 @@ use Geomag;
 use WCY;
 use Time::HiRes qw(gettimeofday tv_interval);
 use BadWords;
+use DXHash;
 
 use strict;
 use vars qw($me $pc11_max_age $pc23_max_age
                        $last_hour %pings %rcmds
-                       %nodehops @baddx $baddxfn $censorpc
+                       %nodehops $baddx $badspotter $badnode $censorpc
                        $allowzero $decode_dk0wcy $send_opernam @checklist);
 
 $me = undef;                                   # the channel id for this cluster
@@ -45,10 +46,11 @@ $last_hour = time;                          # last time I did an hourly periodic update
 %pings = ();                    # outstanding ping requests outbound
 %rcmds = ();                    # outstanding rcmd requests outbound
 %nodehops = ();                 # node specific hop control
-@baddx = ();                    # list of illegal spotted callsigns
 $censorpc = 0;                                 # Do a BadWords::check on text fields and reject things
-
-$baddxfn = "$main::data/baddx.pl";
+                                                               # loads of 'bad things'
+$baddx = new DXHash "baddx";
+$badspotter = new DXHash "badspotter";
+$badnode = new DXHash "badnode";
 
 @checklist = 
 (
@@ -177,10 +179,6 @@ sub init
        do "$main::data/hop_table.pl" if -e "$main::data/hop_table.pl";
        confess $@ if $@;
        $me->{sort} = 'S';    # S for spider
-
-       # load the baddx file
-       do "$baddxfn" if -e "$baddxfn";
-       print "$@\n" if $@;
 }
 
 #
@@ -332,8 +330,14 @@ sub normal
                        }
                        
                        # if this is a 'nodx' node then ignore it
-                       if (grep $field[7] =~ /^$_/,  @DXProt::nodx_node) {
-                               dbg('chan', "PCPROT: Bad DXNode, dropped");
+                       if ($badnode->in($field[7])) {
+                               dbg('chan', "PCPROT: Bad Node, dropped");
+                               return;
+                       }
+                       
+                       # if this is a 'bad spotter' user then ignore it
+                       if ($badspotter->in($field[7])) {
+                               dbg('chan', "PCPROT: Bad Spotter, dropped");
                                return;
                        }
                        
@@ -346,7 +350,7 @@ sub normal
                        }
 
                        # is it 'baddx'
-                       if (grep $field[2] eq $_, @baddx) {
+                       if ($baddx->in($field[2])) {
                                dbg('chan', "PCPROT: Bad DX spot, ignored");
                                return;
                        }
index 59f9627964d8d74166b4629dbd8d68ba1a6cbd72..2a42e71e7c52e06482f34714062a8d5343ccc9c2 100644 (file)
@@ -89,6 +89,11 @@ package DXM;
                                filter6 => '$_[0]$_[1] Filter for $[2] not found',
                                grids => 'DX Grid flag set on $_[0]',
                                gridu => 'DX Grid flag unset on $_[0]',
+                               hasha => '$_[0] already exists in $_[1]',
+                               hashb => '$_[0] added to $_[1]',
+                               hashc => '$_[0] removed from $_[1]',
+                               hashd => '$_[0] not in $_[1]', 
+                               hashe => '$_[0] set on $_[1]', 
                                helpe1 => 'Help system unavailable, tell sysop',
                                helpe2 => 'No help available on $_[0]',
                                heres => 'Here set on $_[0]',