added baddx and badmsg functionality

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

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);
+	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));
+		# send it orf to the cluster (hang onto your tin helmets) 
+		DXProt::broadcast_ak1a(DXProt::pc11($spotter, $freq, $spotted, $line));
+	}
 }
 
 return (1, @out);

cmd/send.pl

@@ -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

data/baddx.pl.issue

@@ -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 
+);

data/badmsg.pl.issue

@@ -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
+);

perl/DXMsg.pm

@@ -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); 
-		
 	}
 }
 

perl/DXProt.pm

@@ -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]);
 			

perl/cluster.pl

@@ -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);