From cdb2c0e3a1d778485f71d406a561b38ed5238dbc Mon Sep 17 00:00:00 2001 From: minima Date: Sun, 20 Aug 2000 12:35:43 +0000 Subject: [PATCH] 2. Add full individual checking for all PC protocol fields in all messages and removed any language dependant stuff (hopefully). --- Changes | 2 + perl/DXDebug.pm | 2 + perl/DXProt.pm | 143 ++++++++++++++++++++++++++++++++++++++++-------- perl/DXUtil.pm | 17 +++++- perl/Prot.pm | 45 ++++++++++++++- perl/cluster.pl | 5 -- 6 files changed, 183 insertions(+), 31 deletions(-) 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'; -- 2.43.0