X-Git-Url: http://gb7djk.dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXProt.pm;h=310416e8dfda883713b863a969a080867e2d55a6;hb=2c3a20bdcef84e620b0c3c2d306a71ebe17956b0;hp=65ad93f930a1bcb164ea623c1fe4f15be8ed19a1;hpb=8e45a3dac2e136dc0c9d6f1e78f8c048a8d7ba21;p=spider.git diff --git a/perl/DXProt.pm b/perl/DXProt.pm index 65ad93f9..310416e8 100644 --- a/perl/DXProt.pm +++ b/perl/DXProt.pm @@ -158,8 +158,8 @@ 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) { + # dump bad protocol messages + if ($line =~ /\%[01][0-9A-F]/) { dbg('chan', "CORRUPT protocol message - dumped"); return; } @@ -175,16 +175,24 @@ 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 $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 } @@ -193,6 +201,16 @@ 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) { @@ -220,12 +238,6 @@ sub normal dbg('chan', "Bad DX spot, ignored"); return; } - - # are any of the crucial fields invalid? - if ($field[2] =~ /(?:^\s*$|[a-z])/ || $field[6] =~ /(?:^\s*$|[a-z])/ || $field[7] =~ /(?:^\s*$|[a-z])/) { - dbg('chan', "Spot contains lower case callsigns or blanks, rejected"); - return; - } # do some de-duping $field[5] =~ s/^\s+//; # take any leading blanks off @@ -303,6 +315,11 @@ sub normal } if ($pcno == 12) { # announces + unless (is_callsign($field[1]) && is_callsign($field[2]) && 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])) { @@ -619,7 +636,7 @@ sub normal my $ref = DXUser->get_current($field[2]); my $cref = DXCluster->get($field[2]); Log('rcmd', 'in', $ref->{priv}, $field[2], $field[3]); - unless ($field[3] =~ /rcmd/i || !$cref || !$ref || $cref->mynode->call ne $ref->homenode) { # not allowed to relay RCMDS! + unless (!$cref || !$ref || $cref->mynode->call ne $ref->homenode) { # not allowed to relay RCMDS! if ($ref->{priv}) { # you have to have SOME privilege, the commands have further filtering $self->{remotecmd} = 1; # for the benefit of any command that needs to know my $oldpriv = $self->{priv}; @@ -1409,6 +1426,12 @@ sub disconnect $self->SUPER::disconnect; } +# check that a field only has callsign characters in it +sub is_callsign +{ + return $_[0] !~ /[^A-Z0-9\-]/ +} + # # send a talk message to this thingy #