X-Git-Url: http://gb7djk.dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXProt.pm;h=6e5efeafbe3246ab9c106479287316d3e3d014be;hb=970d8ae5f1c263bc78390ca35ee876aa41382f21;hp=90506ed4df9ee6c44ea80e115fe0abef9b6c38bc;hpb=4b1dd2cb842a8e7df9b1b3e9a8e166e333dfec0a;p=spider.git diff --git a/perl/DXProt.pm b/perl/DXProt.pm index 90506ed4..6e5efeaf 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,123 @@ $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 m d t m c c h) ], # pc11 + [ qw(c bc m bp bm 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(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 n n n n m c c h) ], # pc23 + [ qw(c p h) ], # pc24 + [ qw(c c n n) ], # pc25 + [ qw(f m d t m c c bc) ], # pc26 + [ qw(d n n n n m c c bc) ], # pc27 + [ qw(c c c c d t p m bp n p bp bc) ], # 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 + undef, # pc38 not interested + [ 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 n n n n n n m m m c c h) ], # 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 < 0 || $n > @checklist; + my $ref = $checklist[$n]; + return 0 unless ref $ref; + + my $i; + shift; # not interested in the first field + for ($i = 0; $i < @$ref; $i++) { + my ($blank, $act) = $$ref[$i] =~ /^(b?)(\w)$/; + return 0 unless $act; + next if $blank && $_[$i] =~ /^[ \*]$/; + 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 unless $_[$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); @@ -58,16 +175,16 @@ sub init $me->{state} = "indifferent"; do "$main::data/hop_table.pl" if -e "$main::data/hop_table.pl"; confess $@ if $@; - # $me->{sort} = 'M'; # M for me + $me->{sort} = 'S'; # S for spider # now prime the spot and wwv duplicates file with data - my @today = Julian::unixtoj(time); - for (Spot::readfile(@today), Spot::readfile(Julian::sub(@today, 1))) { - Spot::dup(@{$_}[0..3]); - } - for (Geomag::readfile(time)) { - Geomag::dup(@{$_}[1..5]); - } +# my @today = Julian::unixtoj(time); +# for (Spot::readfile(@today), Spot::readfile(Julian::sub(@today, 1))) { +# Spot::dup(@{$_}[0..3]); +# } +# for (Geomag::readfile(time)) { +# Geomag::dup(@{$_}[1..5]); +# } # load the baddx file do "$baddxfn" if -e "$baddxfn"; @@ -158,9 +275,10 @@ sub normal return unless $pcno; return if $pcno < 10 || $pcno > 99; - # dump bad protocol messages unless it is a PC29 - if ($line =~ /\%[0-9A-F][0-9A-F]/o && $pcno != 29) { - 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; } @@ -176,15 +294,19 @@ sub normal if ($pcno == 10) { # incoming talk # is it for me or one of mine? - my $call = ($field[5] gt ' ') ? $field[5] : $field[2]; - if ($call eq $main::mycall || grep $_ eq $call, DXChannel::get_all_user_calls()) { - - # yes, it is - my $text = unpad($field[3]); - Log('talk', $call, $field[1], $field[6], $text); - $call = $main::myalias if $call eq $main::mycall; - my $ref = DXChannel->get($call); - $ref->send("$call de $field[1]: $text") if $ref && $ref->{talk}; + my ($to, $via, $call, $dxchan); + if ($field[5] gt ' ') { + $call = $via = $field[2]; + $to = $field[5]; + unless (is_callsign($to)) { + dbg('chan', "Corrupt talk, rejected"); + return; + } + } else { + $call = $to = $field[2]; + } + if ($dxchan = DXChannel->get($call)) { + $dxchan->talk($field[1], $to, $via, $field[3]); } else { $self->route($field[2], $line); # relay it on its way } @@ -220,16 +342,6 @@ sub normal dbg('chan', "Bad DX spot, ignored"); return; } - - # are any of the callsign fields invalid? - if ($field[2] =~ m/[^A-Z0-9\-\/]/ || $field[6] =~ m/[^A-Z0-9\-]/ || $field[7] =~ m/[^A-Z0-9\-]/) { - 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; - } # do some de-duping $field[5] =~ s/^\s+//; # take any leading blanks off @@ -915,9 +1027,9 @@ sub process my $val; my $cutoff; if ($main::systime - 3600 > $last_hour) { - Spot::process; - Geomag::process; - AnnTalk::process; +# Spot::process; +# Geomag::process; +# AnnTalk::process; $last_hour = $main::systime; } } @@ -1413,6 +1525,7 @@ sub disconnect $self->SUPER::disconnect; } + # # send a talk message to this thingy #