added baddx and badmsg functionality
authordjk <djk>
Sun, 31 Jan 1999 13:15:11 +0000 (13:15 +0000)
committerdjk <djk>
Sun, 31 Jan 1999 13:15:11 +0000 (13:15 +0000)
Changes
cmd/dx.pl
cmd/send.pl
data/baddx.pl.issue [new file with mode: 0644]
data/badmsg.pl.issue [new file with mode: 0644]
perl/DXMsg.pm
perl/DXProt.pm
perl/cluster.pl

diff --git a/Changes b/Changes
index 7754e3b875a3a71b8d610b552be3f7498633934a..a05a88edef5f5e7a1e9d85e2a831fbecd8e1be7f 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,3 +1,12 @@
+30Jan99========================================================================
+1. Some of the dates we get can cause crashes, tried to make it more robust (oh
+and Y2K compliant)
+2. PC16 seem to come in with missing callsigns from somewhere
+3. added $main::data/baddx.pl which prevents callsigns that are in the list being
+a) forwarded b) stored and c) (except for the originator, if local) being
+displayed locally.
+4. added $main::data/badmsg.pl which deletes any messages whose TO address is
+in this list (this is largely for european sensibilities). 
 18Jan99========================================================================
 1. added present(),presentish() and disconnect() to DXCron so that you can see 
 (easily) if a station is on the cluster anywhere and also disconnect them
index 3a3d6cf09e5a189709a163f30fd41850ec748aba..b80d89bffb0404cafa226c3b059ac424c44ea988 100644 (file)
--- a/cmd/dx.pl
+++ b/cmd/dx.pl
@@ -80,15 +80,19 @@ return (1, @out) if !$valid;
 # change ^ into : for transmission
 $line =~ s/\^/:/og;
 
-# Store it here
-if (Spot::add($freq, $spotted, $main::systime, $line, $spotter, $main::mycall)) {
-       # send orf to the users
+# Store it here (but only if it isn't baddx)
+if (grep $_ eq $spotted, @DXProt::baddx) {
        my $buf = Spot::formatb($freq, $spotted, $main::systime, $line, $spotter);
-       DXProt::broadcast_users($buf, 'dx', $buf);
-
-
-       # send it orf to the cluster (hang onto your tin helmets)!
-       DXProt::broadcast_ak1a(DXProt::pc11($spotter, $freq, $spotted, $line));
+       push @out, $buf;
+} else {
+       if (Spot::add($freq, $spotted, $main::systime, $line, $spotter, $main::mycall)) {
+               # send orf to the users
+               my $buf = Spot::formatb($freq, $spotted, $main::systime, $line, $spotter);
+               DXProt::broadcast_users($buf, 'dx', $buf);
+
+               # send it orf to the cluster (hang onto your tin helmets) 
+               DXProt::broadcast_ak1a(DXProt::pc11($spotter, $freq, $spotted, $line));
+       }
 }
 
 return (1, @out);
index 9717c3afa3e4b578cc8bbde8858f17cb28edf812..2ebca2a93f9a5aaeb7816360d3aa955382ab80d3 100644 (file)
@@ -102,8 +102,22 @@ if ($self->state eq "prompt") {
        }
   
        # now save all the 'to' callsigns for later
-       my @to = map {uc $_} @f[ $i..$#f ];
-       $loc->{to} = \@to;
+       # first check the 'to' addresses for 'badness'
+    my $t;
+       my @to;
+       foreach  $t (@f[ $i..$#f ]) {
+               $t = uc $t;
+               if (grep $_ eq $t, @DXMsg::badmsg) {
+                       push @out, "Sorry, $t is an unacceptable TO address";
+               } else {
+                       push @to, $t;
+               }
+       }
+       if (@to) {
+               $loc->{to} = \@to;
+       } else {
+               return (1, @out);
+       }
 
        # find me and set the state and the function on my state variable to
        # keep calling me for every line until I relinquish control
diff --git a/data/baddx.pl.issue b/data/baddx.pl.issue
new file mode 100644 (file)
index 0000000..55dfe0c
--- /dev/null
@@ -0,0 +1,19 @@
+#
+# 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/data/badmsg.pl.issue b/data/badmsg.pl.issue
new file mode 100644 (file)
index 0000000..7a1b3fe
--- /dev/null
@@ -0,0 +1,14 @@
+#
+# the list of TO addresses for messages that we won't store having
+# received them (bear in mind that we must receive them fully before
+# we can bin them)
+#
+
+package DXMsg;
+
+@badmsg = qw
+(
+ SALE
+ FORSALE
+ WANTED
+);
index 8dcb09924630aab7de7c3a3547b6988f54dd75fc..f10debfe8818d4f2c567e47c30e859df4a580ea8 100644 (file)
@@ -29,7 +29,8 @@ use FileHandle;
 use Carp;
 
 use strict;
-use vars qw(%work @msg $msgdir %valid %busy $maxage $last_clean);
+use vars qw(%work @msg $msgdir %valid %busy $maxage $last_clean
+                       @badmsg $badmsgfn);
 
 %work = ();                                            # outstanding jobs
 @msg = ();                                             # messages we have
@@ -38,6 +39,8 @@ $msgdir = "$main::root/msg";  # directory contain the msgs
 $maxage = 30 * 86400;                  # the maximum age that a message shall live for if not marked 
 $last_clean = 0;                               # last time we did a clean
 
+$badmsgfn = "$main::data/badmsg.pl";  # list of TO address we wont store
+
 %valid = (
                  fromnode => '9,From Node',
                  tonode => '9,To Node',
@@ -195,6 +198,14 @@ sub process
                                                                return;
                                                        }
                                                }
+                                                       
+                                               # look for 'bad' to addresses 
+                                               if (grep $ref->{to} eq $_, @badmsg) {
+                                                       $ref->stop_msg($self);
+                                                       dbg('msg', "'Bad' TO address $ref->{to}");
+                                                       Log('msg', "'Bad' TO address $ref->{to}");
+                                                       return;
+                                               }
 
                                                $ref->{msgno} = next_transno("Msgno");
                                                push @{$ref->{gotit}}, $f[2]; # mark this up as being received
@@ -621,7 +632,10 @@ sub init
        my $dir = new FileHandle;
        my @dir;
        my $ref;
-       
+
+       do "$badmsgfn" if -e "$badmsgfn";
+       print "$@\n" if $@;
+
        # read in the directory
        opendir($dir, $msgdir) or confess "can't open $msgdir $!";
        @dir = readdir($dir);
@@ -629,15 +643,21 @@ sub init
 
        @msg = ();
        for (sort @dir) {
-               next if /^\./o;
-               next if ! /^m\d+/o;
+               next unless /^m\d+/o;
                
                $ref = read_msg_header("$msgdir/$_");
-               next if !$ref;
+               next unless $ref;
                
+               # delete any messages to 'badmsg.pl' places
+               if (grep $ref->{to} eq $_, @badmsg) {
+                       dbg('msg', "'Bad' TO address $ref->{to}");
+                       Log('msg', "'Bad' TO address $ref->{to}");
+                       $ref->del_msg;
+                       next;
+               }
+
                # add the message to the available queue
                add_dir($ref); 
-               
        }
 }
 
index ff891427079e0da82419badd01176534a9be815e..2feeda2d3d19282e1bb7ca5fa0d49b078fd6fe84 100644 (file)
@@ -27,7 +27,9 @@ use Local;
 use Carp;
 
 use strict;
-use vars qw($me $pc11_max_age $pc11_dup_age $pc23_dup_age %spotdup %wwvdup $last_hour %pings %rcmds %nodehops);
+use vars qw($me $pc11_max_age $pc11_dup_age $pc23_dup_age 
+                       %spotdup %wwvdup $last_hour %pings %rcmds 
+                       %nodehops @baddx $baddxfn);
 
 $me = undef;                                   # the channel id for this cluster
 $pc11_max_age = 1*3600;                        # the maximum age for an incoming 'real-time' pc11
@@ -39,7 +41,9 @@ $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
 
+$baddxfn = "$main::data/baddx.pl";
 
 sub init
 {
@@ -69,6 +73,9 @@ sub init
                $wwvdup{$dupkey} = $_->[1];
        }
 
+       # load the baddx file
+       do "$baddxfn" if -e "$baddxfn";
+       print "$@\n" if $@;
 }
 
 #
@@ -189,6 +196,12 @@ sub normal
                        }
                        
                        $spotdup{$dupkey} = $d;
+
+                       # is it 'baddx'
+                       if (grep $field[2] eq $_, @baddx) {
+                               dbg('chan', "Bad DX spot, ignored");
+                               return;
+                       }
                        
                        my $spot = Spot::add($freq, $field[2], $d, $text, $spotter, $field[7]);
                        
index fd78191479e9e171c0a6ab5003bf6ac664c89808..1c1ba3c8581cac29b4b82d3ccb7e299a960231dd 100755 (executable)
@@ -165,6 +165,10 @@ sub cease
        foreach $dxchan (DXChannel->get_all()) {
                disconnect($dxchan) unless $dxchan == $DXProt::me;
        }
+       Msg->event_loop(1, 0.05);
+       Msg->event_loop(1, 0.05);
+       Msg->event_loop(1, 0.05);
+       Msg->event_loop(1, 0.05);
        Log('cluster', "DXSpider V$version stopped");
        unlink $lockfn;
        exit(0);