X-Git-Url: http://dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXProt.pm;h=5ba2657118a470c03fb2653e614df7e94c9b036b;hb=f8e8ba13693b1a7685601f1847cb8e6493604ed9;hp=7a2ca91036c396001b8ba557f4e08f2e2c656bb6;hpb=65bf111b2d360cf15aa470020872d593f21e3740;p=spider.git diff --git a/perl/DXProt.pm b/perl/DXProt.pm index 7a2ca910..5ba26571 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); + $allowzero $decode_dk0wcy $send_opernam); $me = undef; # the channel id for this cluster $pc11_max_age = 1*3600; # the maximum age for an incoming 'real-time' pc11 @@ -96,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; @@ -263,7 +263,7 @@ sub normal my $node; my $to = $user->homenode; my $last = $user->lastoper || 0; - if ($main::systime > $last + $DXUser::lastoperinterval && $to && ($node = DXCluster->get_exact($to)) ) { + 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) { @@ -271,6 +271,15 @@ sub normal } 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; } @@ -688,12 +697,11 @@ sub normal my ($lat, $long) = DXBearing::stoll($field[3]); $user->lat($lat); $user->long($long); - my $qra = $user->qra || DXBearing::lltoqra($lat, $long); - $qra = DXBearing::lltoqra($lat, $long) unless $qra && DXBearing::is_qra($qra); - $user->qra($qra) if $qra ne $user->qra; + $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; } @@ -791,7 +799,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}; @@ -815,7 +823,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; @@ -839,7 +847,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;