X-Git-Url: http://dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXProt.pm;h=310416e8dfda883713b863a969a080867e2d55a6;hb=2c3a20bdcef84e620b0c3c2d306a71ebe17956b0;hp=88aef0db00395a2be049f12f8590be58d66c529d;hpb=f155969d600561b9ef151a7ce2494a0c89aed033;p=spider.git diff --git a/perl/DXProt.pm b/perl/DXProt.pm index 88aef0db..310416e8 100644 --- a/perl/DXProt.pm +++ b/perl/DXProt.pm @@ -34,10 +34,9 @@ use strict; use vars qw($me $pc11_max_age $pc23_max_age $last_hour %pings %rcmds %nodehops @baddx $baddxfn - $allowzero $decode_dk0wcy); + $allowzero $decode_dk0wcy $send_opernam); $me = undef; # the channel id for this cluster -$decode_dk0wcy = undef; # if set use this callsign to decode announces from the EU WWV data beacon $pc11_max_age = 1*3600; # the maximum age for an incoming 'real-time' pc11 $pc23_max_age = 1*3600; # the maximum age for an incoming 'real-time' pc23 @@ -97,8 +96,8 @@ sub start # remember type of connection $self->{consort} = $line; $self->{outbound} = $sort eq 'O'; - $self->{priv} = $user->priv; - $self->{lang} = $user->lang; + $self->{priv} = $user->priv || 1; # other clusters can always be 'normal' users + $self->{lang} = $user->lang || 'en'; $self->{isolate} = $user->{isolate}; $self->{consort} = $line; # save the connection type $self->{here} = 1; @@ -106,6 +105,7 @@ sub start # get the INPUT filters (these only pertain to Clusters) $self->{inspotfilter} = Filter::read_in('spots', $call, 1); $self->{inwwvfilter} = Filter::read_in('wwv', $call, 1); + $self->{inwcyfilter} = Filter::read_in('wcy', $call, 1); $self->{inannfilter} = Filter::read_in('ann', $call, 1); # set unbuffered and no echo @@ -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,14 +238,9 @@ sub normal dbg('chan', "Bad DX spot, ignored"); return; } - - # are any of the crucial fields invalid? - if ($field[2] =~ /[a-z]/ || $field[6] =~ /[a-z]/ || $field[7] =~ /[a-z]/) { - dbg('chan', "Spot contains lower case callsigns, rejected"); - return; - } # do some de-duping + $field[5] =~ s/^\s+//; # take any leading blanks off if (Spot::dup($field[1], $field[2], $d, $field[5])) { dbg('chan', "Duplicate Spot ignored\n"); return; @@ -242,6 +255,49 @@ sub normal # you should be able to route on any of these # + # fix up qra locators of known users + my $user = DXUser->get_current($spot[4]); + if ($user) { + my $qra = $user->qra; + unless ($qra && DXBearing::is_qra($qra)) { + my $lat = $user->lat; + my $long = $user->long; + if (defined $lat && defined $long) { + $user->qra(DXBearing::lltoqra($lat, $long)); + $user->put; + } + } + + # send a remote command to a distant cluster if it is visible and there is no + # qra locator and we havn't done it for a month. + + unless ($user->qra) { + my $node; + my $to = $user->homenode; + my $last = $user->lastoper || 0; + if ($send_opernam && $main::systime > $last + $DXUser::lastoperinterval && $to && ($node = DXCluster->get_exact($to)) ) { + my $cmd = "forward/opernam $spot[4]"; + # send the rcmd but we aren't interested in the replies... + if ($node && $node->dxchan && $node->dxchan->is_clx) { + route(undef, $to, pc84($main::mycall, $to, $main::mycall, $cmd)); + } else { + route(undef, $to, pc34($main::mycall, $to, $cmd)); + } + if ($to ne $field[7]) { + $to = $field[7]; + $node = DXCluster->get_exact($to); + if ($node && $node->dxchan && $node->dxchan->is_clx) { + route(undef, $to, pc84($main::mycall, $to, $main::mycall, $cmd)); + } else { + route(undef, $to, pc34($main::mycall, $to, $cmd)); + } + } + $user->lastoper($main::systime); + $user->put; + } + } + } + # local processing my $r; eval { @@ -259,7 +315,13 @@ 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])) { dbg('chan', "Duplicate Announce ignored\n"); return; @@ -278,13 +340,6 @@ sub normal # send it $self->send_announce($line, @field[1..6]); - - if ($decode_dk0wcy && $field[1] eq $decode_dk0wcy) { - my ($hour, $k, $next, $a, $r, $sfi, $alarm) = $field[3] =~ /^Aurora Beacon\s+(\d+)UTC,\s+Kiel\s+K=(\d+),.*ed\s+K=(\d+),\s+A=(\d+),\s+R=(\d+),\s+SFI=(\d+),.*larm:\s+(\w+)/; - $alarm = ($alarm =~ /^Y/i) ? ', Aurora in DE' : ''; - my $wwv = Geomag::update($main::systime, $hour, $sfi, $a, $k, "R=$r, Next K=$next$alarm", $decode_dk0wcy, $field[5], $r) if $sfi && $r; - } - } else { $self->route($field[2], $line); } @@ -581,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}; @@ -618,6 +673,10 @@ sub normal my $dxchan = DXChannel->get($s->{call}); $dxchan->send($field[3]) if $dxchan; delete $rcmds{$field[2]} if !$dxchan; + } else { + # send unsolicited ones to the sysop + my $dxchan = DXChannel->get($main::myalias); + $dxchan->send($field[3]) if $dxchan; } } else { my $ref = DXUser->get_current($field[1]); @@ -659,9 +718,11 @@ sub normal my ($lat, $long) = DXBearing::stoll($field[3]); $user->lat($lat); $user->long($long); + $user->qra(DXBearing::lltoqra($lat, $long)) unless $user->qra && DXBearing::is_qra($user->qra); } elsif ($field[2] == 4) { $user->homenode($field[3]); } + $user->lastoper($main::systime); # to cut down on excessive for/opers being generated $user->put; last SWITCH; } @@ -759,7 +820,7 @@ sub normal my $ref = DXUser->get_current($field[2]); my $cref = DXCluster->get($field[2]); Log('rcmd', 'in', $ref->{priv}, $field[2], $field[4]); - unless ($field[3] =~ /rcmd/i || !$cref || !$ref || $cref->mynode->call ne $ref->homenode) { # not allowed to relay RCMDS! + unless ($field[4] =~ /rcmd/i || !$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}; @@ -783,7 +844,7 @@ sub normal if ($ref && $ref->is_clx) { $self->route($field[1], $line); } else { - route($field[1], pc34($field[2], $field[1], $field[3])); + route($field[1], pc34($field[2], $field[1], $field[4])); } } return; @@ -800,6 +861,10 @@ sub normal $dxchan = DXChannel->get($s->{call}); $dxchan->send($field[4]) if $dxchan; delete $rcmds{$field[2]} if !$dxchan; + } else { + # send unsolicited ones to the sysop + my $dxchan = DXChannel->get($main::myalias); + $dxchan->send($field[4]) if $dxchan; } } } else { @@ -807,7 +872,7 @@ sub normal if ($ref && $ref->is_clx) { $self->route($field[1], $line); } else { - route($field[1], pc35($field[2], $field[1], $field[3])); + route($field[1], pc35($field[2], $field[1], $field[4])); } } return; @@ -877,11 +942,9 @@ sub finish { my $self = shift; my $call = $self->call; - my $nopc39 = shift; + my $conn = shift; my $ref = DXCluster->get_exact($call); - $self->send_now("D", DXProt::pc39($main::mycall, $self->msg('disc1', "System Op"))) unless $nopc39; - # unbusy and stop and outgoing mail my $mref = DXMsg::get_busy($call); $mref->stop_msg($call) if $mref; @@ -948,9 +1011,9 @@ sub send_dx_spot $dxchan->send($routeit) unless $dxchan->{isolate} || $self->{isolate}; } } elsif ($dxchan->is_user && $dxchan->{dx}) { - my $buf = Spot::formatb($_[0], $_[1], $_[2], $_[3], $_[4]); + my $buf = Spot::formatb($dxchan->{user}->wantgrid, $_[0], $_[1], $_[2], $_[3], $_[4]); $buf .= "\a\a" if $dxchan->{beep}; - if ($dxchan->{state} eq 'prompt' || $dxchan->{state} eq 'convers') { + if ($dxchan->{state} eq 'prompt' || $dxchan->{state} eq 'talk') { $dxchan->send($buf); } else { $dxchan->delay($buf); @@ -994,7 +1057,7 @@ sub send_wwv_spot } elsif ($dxchan->is_user && $dxchan->{wwv}) { my $buf = "WWV de $_[6] <$_[1]>: SFI=$_[2], A=$_[3], K=$_[4], $_[5]"; $buf .= "\a\a" if $dxchan->{beep}; - if ($dxchan->{state} eq 'prompt' || $dxchan->{state} eq 'convers') { + if ($dxchan->{state} eq 'prompt' || $dxchan->{state} eq 'talk') { $dxchan->send($buf); } else { $dxchan->delay($buf); @@ -1037,7 +1100,7 @@ sub send_wcy_spot } elsif ($dxchan->is_user && $dxchan->{wcy}) { my $buf = "WCY de $_[10] <$_[1]> : K=$_[4] expK=$_[5] A=$_[3] R=$_[6] SFI=$_[2] SA=$_[7] GMF=$_[8] Au=$_[9]"; $buf .= "\a\a" if $dxchan->{beep}; - if ($dxchan->{state} eq 'prompt' || $dxchan->{state} eq 'convers') { + if ($dxchan->{state} eq 'prompt' || $dxchan->{state} eq 'talk') { $dxchan->send($buf); } else { $dxchan->delay($buf); @@ -1101,7 +1164,7 @@ sub send_announce next if $target eq 'SYSOP' && $dxchan->{priv} < 5; my $buf = "$to$target de $_[0]: $text"; $buf .= "\a\a" if $dxchan->{beep}; - if ($dxchan->{state} eq 'prompt' || $dxchan->{state} eq 'convers') { + if ($dxchan->{state} eq 'prompt' || $dxchan->{state} eq 'talk') { $dxchan->send($buf); } else { $dxchan->delay($buf); @@ -1252,7 +1315,7 @@ sub broadcast_list $s =~ s/\a//og unless $dxchan->{beep}; - if ($dxchan->{state} eq 'prompt' || $dxchan->{state} eq 'convers') { + if ($dxchan->{state} eq 'prompt' || $dxchan->{state} eq 'talk') { $dxchan->send($s); } else { $dxchan->delay($s); @@ -1350,5 +1413,35 @@ sub addrcmd route(undef, $to, pc34($main::mycall, $to, $cmd)); } } + +sub disconnect +{ + my $self = shift; + my $nopc39 = shift; + + if ($self->{conn} && !$nopc39) { + $self->send_now("D", DXProt::pc39($main::mycall, $self->msg('disc1', "System Op"))); + } + + $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 +# +sub talk +{ + my ($self, $from, $to, $via, $line) = @_; + + $line =~ s/\^/\\5E/g; # remove any ^ characters + $self->send(DXProt::pc10($from, $to, $via, $line)); + Log('talk', $self->call, $from, $via?$via:$main::mycall, $line); +} 1; __END__