From: minima <minima>
Date: Sun, 20 Aug 2000 12:35:43 +0000 (+0000)
Subject: 2. Add full individual checking for all PC protocol fields in all messages
X-Git-Tag: R_1_44~28
X-Git-Url: http://dxcluster.net/gitweb/gitweb.cgi?a=commitdiff_plain;h=cdb2c0e3a1d778485f71d406a561b38ed5238dbc;p=spider.git

2. Add full individual checking for all PC protocol fields in all messages
and removed any language dependant stuff (hopefully).
---

diff --git a/Changes b/Changes
index 25a1007d..10f58fb7 100644
--- a/Changes
+++ b/Changes
@@ -1,5 +1,7 @@
 20Aug00=======================================================================
 1. Added system Alias for set/nodxgrid => unset/dxgrid
+2. Add full individual checking for all PC protocol fields in all messages
+and removed any language dependant stuff (hopefully).
 19Aug00=======================================================================
 1. Added an efficiency thing for AUTOLOADed accessors from OO Perl by Conway.
 2. Fiddled with the rtty and digital bandplan frequencies.
diff --git a/perl/DXDebug.pm b/perl/DXDebug.pm
index a1c63407..ac452413 100644
--- a/perl/DXDebug.pm
+++ b/perl/DXDebug.pm
@@ -56,6 +56,8 @@ sub _store
 		chomp;
 		my @l = split /\n/;
 		for (@l) {
+			my $l = $_;
+			$l =~ s/([\x00\x08\x0B-\x1f\x7f-\xff])/uc sprintf("%%%02x",ord($1))/eg;			
 			print "$_\n" if defined \*STDOUT;
 			$fp->writeunix($t, "$t^$_"); 
 		}
diff --git a/perl/DXProt.pm b/perl/DXProt.pm
index 5ba3b2bd..4f9e2220 100644
--- a/perl/DXProt.pm
+++ b/perl/DXProt.pm
@@ -34,7 +34,7 @@ use strict;
 use vars qw($me $pc11_max_age $pc23_max_age
 			$last_hour %pings %rcmds
 			%nodehops @baddx $baddxfn 
-			$allowzero $decode_dk0wcy $send_opernam);
+			$allowzero $decode_dk0wcy $send_opernam @checklist);
 
 $me = undef;					# the channel id for this cluster
 $pc11_max_age = 1*3600;			# the maximum age for an incoming 'real-time' pc11
@@ -49,6 +49,121 @@ $last_hour = time;				# last time I did an hourly periodic update
 
 $baddxfn = "$main::data/baddx.pl";
 
+@checklist = 
+(
+ qw(c c m p bc c),				# pc10
+ qw(f c m d t c c h),			# pc11
+ qw(c bc m p c p h),			# pc12
+ qw(c h),
+ qw(c h),
+ qw(c m h),
+ undef,							# pc16 has to be validated manually
+ qw(c c h),						# pc17
+ qw(c m n),						# pc18
+ undef,							# pc19 has to be validated manually
+ undef,							# pc20 no validation
+ qw(c m h),						# pc21
+ undef,							# pc22 no validation
+ qw(d t n n n m c c h),			# pc23
+ qw(c p h),						# pc24
+ qw(c c n n),					# pc25
+ qw(f c m d t c c),				# pc26
+ qw(d t n n n m c c),			# pc27
+ qw(c c c c d t p m bp n p bp c), # pc28
+ qw(c c n m),					# pc29
+ qw(c c n),						# pc30
+ qw(c c n),						# pc31
+ qw(c c n),						# pc32
+ qw(c c n),						# pc33
+ qw(c c m),						# pc34
+ qw(c c m),						# pc35
+ qw(c c m),						# pc36
+ qw(c c n m),					# pc37
+ qw(c m),						# pc39
+ qw(c c m p n),					# pc40
+ qw(c n m h),					# pc41
+ qw(c c n),						# pc42
+ undef,							# pc43 don't handle it
+ qw(c c n m m c),				# pc44
+ qw(c c n m),					# pc45
+ qw(c c n),						# pc46
+ undef,							# pc47
+ undef,							# pc48
+ qw(c m h),						# pc49
+ qw(c n h),						# pc50
+ qw(c c n),						# pc51
+ undef,
+ undef,
+ undef,
+ undef,
+ undef,
+ undef,
+ undef,
+ undef,
+ undef,							# pc60
+ undef,
+ undef,
+ undef,
+ undef,
+ undef,
+ undef,
+ undef,
+ undef,
+ undef,
+ undef,							# pc70
+ undef,
+ undef,
+ qw(d t n n n n n n m m m c c),	# pc73
+ undef,
+ undef,
+ undef,
+ undef,
+ undef,
+ undef,
+ undef,							# pc80
+ undef,
+ undef,
+ undef,
+ qw(c c c m),					# pc84
+ qw(c c c m),					# pc85
+);
+
+# use the entry in the check list to check the field list presented
+# return OK if line NOT in check list (for now)
+sub check
+{
+	my $n = shift;
+	$n -= 10;
+	return 0 if $n < 10 || $n > @checklist; 
+	my $ref = $checklist[$n];
+	return 0 unless ref $ref;
+	
+	my $i;
+	shift;    # not interested in the first field
+	for ($i = 0; $i < @_; $i++) {
+		my ($blank, $act) = $$ref[$i] =~ /^(b?)(\w)$/;
+		next if $blank && $_[$i] eq ' ';
+		if ($act eq 'c') {
+			return $i+1 unless is_callsign($_[$i]);
+		} elsif ($act eq 'm') {
+			return $i+1 unless is_pctext($_[$i]);
+		} elsif ($act eq 'p') {
+			return $i+1 unless is_pcflag($_[$i]);
+		} elsif ($act eq 'f') {
+			return $i+1 unless is_freq($_[$i]);
+		} elsif ($act eq 'n') {
+			return $i+1 if $_[$i] !~ /^[^\d ]$/;
+		} elsif ($act eq 'h') {
+			return $i+1 unless $_[$i] =~ /^H\d\d?$/;
+		} elsif ($act eq 'd') {
+			return $i+1 unless $_[$i] =~ /^\s*\d+-\w\w\w-[12][90]\d\d$/;
+		} elsif ($act eq 't') {
+			return $i+1 unless $_[$i] =~ /^[012]\d[012345]\dZ$/;
+		}
+	}
+	return 0;
+}
+
 sub init
 {
 	my $user = DXUser->get($main::mycall);
@@ -158,9 +273,10 @@ sub normal
 	return unless $pcno;
 	return if $pcno < 10 || $pcno > 99;
 
-	# dump bad protocol messages
-	if ($pcno != 29 && $line =~ /\%[01][0-9A-F]/) {
-		dbg('chan', "CORRUPT protocol message - dumped");
+	# check for and dump bad protocol messages
+	my $n = check($pcno, @field);
+	if ($n) {
+		dbg('chan', "bad field $n, dumped (" . parray($checklist[$pcno-10]) . ")");
 		return;
 	}
 
@@ -175,10 +291,6 @@ sub normal
  SWITCH: {
 		if ($pcno == 10) {		# incoming talk
 			
-			unless (is_callsign($field[1]) && is_callsign($field[2]) && is_callsign($field[6])) {
-				dbg('chan', "Corrupt talk, rejected");
-				return;
-			}
 			# is it for me or one of mine?
 			my ($to, $via, $call, $dxchan);
 			if ($field[5] gt ' ') {
@@ -201,16 +313,6 @@ sub normal
 		
 		if ($pcno == 11 || $pcno == 26) { # dx spot
 
-			# are any of the callsign fields invalid?
-            unless ($field[2] !~ m/[^A-Z0-9\-\/]/ && is_callsign($field[6]) && is_callsign($field[7])) {
-				dbg('chan', "Spot contains lower case callsigns or blanks, rejected");
-				return;
-			}
-            if ($field[1] =~ m/[^0-9\.]/) {
-				dbg('chan', "Spot frequency not numeric, rejected");
-				return;
-			}
-
 			# route 'foreign' pc26s 
 			if ($pcno == 26) {
 				if ($field[7] ne $main::mycall) {
@@ -315,11 +417,6 @@ sub normal
 		}
 		
 		if ($pcno == 12) {		# announces
-			unless (is_callsign($field[1]) && is_callsign($field[5])) {
-				dbg('chan', "Corrupt announce, rejected");
-				return;
-			}
-
 			# announce duplicate checking
 			$field[3] =~ s/^\s+//;  # remove leading blanks
 			if (AnnTalk::dup($field[1], $field[2], $field[3])) {
diff --git a/perl/DXUtil.pm b/perl/DXUtil.pm
index d1079035..0fb6b8db 100644
--- a/perl/DXUtil.pm
+++ b/perl/DXUtil.pm
@@ -17,6 +17,7 @@ require Exporter;
 @EXPORT = qw(atime ztime cldate cldatetime slat slong yesno promptf 
 			 parray parraypairs shellregex readfilestr writefilestr
              print_all_fields cltounix iscallsign unpad is_callsign
+			 is_freq is_digits
             );
 
 @month = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
@@ -301,8 +302,20 @@ sub is_pctext
 	return $_[0] !~ /[^\x20-\xA8\xE0-\xEF]/;
 }
 
-# check that a PC prot flag is set correctly
+# check that a PC prot flag is fairly valid (doesn't check the difference between 1/0 and */-)
 sub is_pcflag
 {
-	return $_[0] !~ /^[^01\*]$/;
+	return $_[0] !~ /^[^01\*\-]$/;
+}
+
+# check that a thing is a frequency
+sub is_freq
+{
+	return $_[0] !~ /[^\d\.]/;
+}
+
+# check that a thing is just digits
+sub is_digits
+{
+	return $_[0] !~ /[^\d]/;
 }
diff --git a/perl/Prot.pm b/perl/Prot.pm
index 4576196a..67741752 100644
--- a/perl/Prot.pm
+++ b/perl/Prot.pm
@@ -6,13 +6,56 @@ package Prot;
 
 use strict;
 
+use DXUtil;
+use DXDebug;
+use vars qw(%valid);
+
+%valid = (
+		  fromnode => '0,From Node',
+		  tonode => '0,To Node',
+		  vianode => '0,Via Node',
+		  origin => '0,Original Node',
+		  tocall => '0,To Callsign',
+		  fromcall => '0,From Callsign',
+		  hops => '0,No. of hops',
+		  text => '0,Text',
+		  datetime => '0,Date/Time,atime',
+		  freq => '0,Frequency',
+		  dxcall => '0,DX Callsign',
+		  sort => '0,Sort',
+		  hereflag => '0,Here?,yesno',
+		  talkflag => '0,Talk mode',
+		  bellflag => '0,Bell?',
+		  privflag => '0,Private?,yesno',
+		  rrflag => '0,RR Req.?,yesno',
+		  sysopflag => '0,Sysop flag',
+		  dxcount => '0,DX Count',
+		  wwvcount => '0,WWV Count',
+		  version => '0,Node Version',
+		  nodelist => '0,Node List,parray',
+		 );
+
+
 sub new
 {
 	my $pkg = shift;
-	my $self = bless {}, $pkg;
+	my $sort = shift;
+	my $self = bless { sort => $sort }, $pkg;
 	return $self;
 }
 
+sub AUTOLOAD
+{
+	no strict "refs";
+	my $self = shift;
+	my $name = $AUTOLOAD;
+	return if $name =~ /::DESTROY$/;
+	$name =~ s/.*:://o;
+  
+	confess "Non-existant field '$AUTOLOAD'" if !$valid{$name};
+	*{$AUTOLOAD} = sub {@_ > 1 ? $_[0]->{$name} = $_[1] : $_[0]->{$name}} ;
+    @_ ? $self->{$name} = shift : $self->{$name} ;
+}
 
 1;
 __END__
diff --git a/perl/cluster.pl b/perl/cluster.pl
index 1ecbc094..ec1030e8 100755
--- a/perl/cluster.pl
+++ b/perl/cluster.pl
@@ -253,11 +253,6 @@ sub process_inqueue
 	my ($sort, $call, $line) = DXChannel::decode_input($dxchan, $data);
 	return unless defined $sort;
 	
-	# translate any crappy characters into hex characters 
-	if ($line =~ /[\x00-\x06\x08\x0a-\x1f\x7f-\xff]/o) {
-		$line =~ s/([\x00-\x1f\x7f-\xff])/uc sprintf("%%%02x",ord($1))/eg;
-	}
-
 	# do the really sexy console interface bit! (Who is going to do the TK interface then?)
 	dbg('chan', "<- $sort $call $line\n") unless $sort eq 'D';