X-Git-Url: http://gb7djk.dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXProt.pm;h=8ee77084fd0a339f70f05912cb5b75e129e71b95;hb=66efc9cee6be378f570c0f08f0f41ba739a3d8d2;hp=966f0eefb0d88f4a5f4d7d8a105329542deef3df;hpb=6624dcdf07d628e8d6a16fc6549edf40be25b7b2;p=spider.git diff --git a/perl/DXProt.pm b/perl/DXProt.pm index 966f0eef..8ee77084 100644 --- a/perl/DXProt.pm +++ b/perl/DXProt.pm @@ -34,7 +34,14 @@ use Route; use Route::Node; use strict; -use vars qw($me $pc11_max_age $pc23_max_age + +use vars qw($VERSION $BRANCH); +$VERSION = sprintf( "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/ ); +$BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/ ) || 0; +$main::build += $VERSION; +$main::branch += $BRANCH; + +use vars qw($me $pc11_max_age $pc23_max_age $last_pc50 $last_hour $last10 %eph %pings %rcmds %nodehops $baddx $badspotter $badnode $censorpc $allowzero $decode_dk0wcy $send_opernam @checklist); @@ -52,7 +59,7 @@ $censorpc = 1; # Do a BadWords::check on text fields and reject things $baddx = new DXHash "baddx"; $badspotter = new DXHash "badspotter"; $badnode = new DXHash "badnode"; -$last10 = time; +$last10 = $last_pc50 = time; @checklist = ( @@ -213,18 +220,21 @@ sub start # remember type of connection $self->{consort} = $line; $self->{outbound} = $sort eq 'O'; - $self->{priv} = $user->priv || 1; # other clusters can always be 'normal' users + my $priv = $user->priv; + $priv = $user->priv(1) unless $priv; + $self->{priv} = $priv; # 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; + $self->{width} = 80; # get the output filters $self->{spotsfilter} = Filter::read_in('spots', $call, 0) || Filter::read_in('spots', 'node_default', 0); $self->{wwvfilter} = Filter::read_in('wwv', $call, 0) || Filter::read_in('wwv', 'node_default', 0); $self->{wcyfilter} = Filter::read_in('wcy', $call, 0) || Filter::read_in('wcy', 'node_default', 0); $self->{annfilter} = Filter::read_in('ann', $call, 0) || Filter::read_in('ann', 'node_default', 0) ; - $self->{routefilter} = Filter::read_in('route', $call, 0) || Filter::read_in('route', 'node_default', 0) ; + $self->{routefilter} = Filter::read_in('route', $call, 0) || Filter::read_in('route', 'node_default', 0) unless $self->{isolate} ; # get the INPUT filters (these only pertain to Clusters) @@ -232,7 +242,7 @@ sub start $self->{inwwvfilter} = Filter::read_in('wwv', $call, 1) || Filter::read_in('wwv', 'node_default', 1); $self->{inwcyfilter} = Filter::read_in('wcy', $call, 1) || Filter::read_in('wcy', 'node_default', 1); $self->{inannfilter} = Filter::read_in('ann', $call, 1) || Filter::read_in('ann', 'node_default', 1); - $self->{inroutefilter} = Filter::read_in('route', $call, 1) || Filter::read_in('route', 'node_default', 1); + $self->{inroutefilter} = Filter::read_in('route', $call, 1) || Filter::read_in('route', 'node_default', 1) unless $self->{isolate}; # set unbuffered and no echo $self->send_now('B',"0"); @@ -406,7 +416,7 @@ sub normal my $user = DXUser->get_current($spot[4]); if ($user) { my $qra = $user->qra; - unless ($qra && DXBearing::is_qra($qra)) { + unless ($qra && is_qra($qra)) { my $lat = $user->lat; my $long = $user->long; if (defined $lat && defined $long) { @@ -422,7 +432,7 @@ sub normal my $node; my $to = $user->homenode; my $last = $user->lastoper || 0; - if ($to ne $main::mycall && $send_opernam && $main::systime > $last + $DXUser::lastoperinterval && $to && ($node = Route::Node::get($to)) ) { + if ($send_opernam && $to && $to ne $main::mycall && $main::systime > $last + $DXUser::lastoperinterval && ($node = Route::Node::get($to)) ) { my $cmd = "forward/opernam $spot[4]"; # send the rcmd but we aren't interested in the replies... my $dxchan = $node->dxchan; @@ -556,6 +566,8 @@ sub normal my ($call, $conf, $here) = $field[$i] =~ /^(\S+) (\S) (\d)/o; next unless $call && $conf && defined $here && is_callsign($call); next if $call eq $main::mycall; + + eph_del_regex("^PC17\^$call\^$ncall"); $conf = $conf eq '*'; @@ -567,7 +579,7 @@ sub normal $r->flags($flags); push @rout, $r; } - $r->addparent($ncall); + $r->addparent($parent); } else { push @rout, $parent->add_user($call, $flags); } @@ -582,6 +594,10 @@ sub normal $user->put; } + if (eph_dup($line)) { + dbg("PCPROT: dup PC16 detected") if isdbg('chanerr'); + return; + } # queue up any messages (look for privates only) DXMsg::queue_msg(1) if $self->state eq 'normal'; @@ -594,6 +610,9 @@ sub normal my $dxchan; my $ncall = $field[2]; my $ucall = $field[1]; + + eph_del_regex("^PC16.*$ncall.*$ucall"); + if ($ncall eq $main::mycall) { dbg("PCPROT: trying to alter config on this node from outside!") if isdbg('chanerr'); return; @@ -608,11 +627,23 @@ sub normal dbg("PCPROT: Route::Node $ncall not in config") if isdbg('chanerr'); return; } + my $uref = Route::User::get($ucall); + unless ($uref) { + dbg("PCPROT: Route::User $ucall not in config") if isdbg('chanerr'); + return; + } + # input filter if required return unless $self->in_filter_route($parent); + + my @rout = $parent->del_user($uref); + + if (eph_dup($line)) { + dbg("PCPROT: dup PC17 detected") if isdbg('chanerr'); + return; + } - my @rout = $parent->del_user($ucall); $self->route_pc17($parent, @rout) if @rout; return; } @@ -623,7 +654,7 @@ sub normal # first clear out any nodes on this dxchannel my $parent = Route::Node::get($self->{call}); my @rout = $parent->del_nodes; - $self->route_pc21(@rout, $parent); + $self->route_pc21(@rout, $parent) if @rout; $self->send_local_config(); $self->send(pc20()); return; # we don't pass these on @@ -649,6 +680,9 @@ sub normal my $conf = $field[$i+2]; my $ver = $field[$i+3]; next unless defined $here && defined $conf && is_callsign($call); + + eph_del_regex("^PC(?:21\^$call|17\^[^\^]+\^$call)"); + # check for sane parameters $ver = 5000 if $ver eq '0000'; next if $ver < 5000; # only works with version 5 software @@ -698,7 +732,7 @@ sub normal $user = DXUser->new($call); $user->sort('A'); $user->priv(1); # I have relented and defaulted nodes - $self->{priv} = 1; # to user RCMDs allowed + $user->lockout(1); $user->homenode($call); $user->node($call); } @@ -706,6 +740,11 @@ sub normal $user->put; } + if (eph_dup($line)) { + dbg("PCPROT: dup PC19 detected") if isdbg('chanerr'); + return; + } + $self->route_pc19(@rout) if @rout; return; } @@ -719,6 +758,9 @@ sub normal if ($pcno == 21) { # delete a cluster from the list my $call = uc $field[1]; + + eph_del_regex("^PC1[79].*$call"); + my @rout; my $parent = Route::Node::get($self->{call}); unless ($parent) { @@ -744,6 +786,12 @@ sub normal dbg("PCPROT: I WILL _NOT_ be disconnected!") if isdbg('chanerr'); return; } + + if (eph_dup($line)) { + dbg("PCPROT: dup PC21 detected") if isdbg('chanerr'); + return; + } + $self->route_pc21(@rout) if @rout; return; } @@ -824,7 +872,7 @@ sub normal return; } - Log('DXProt', "Merge request for $field[3] spots and $field[4] WWV from $field[1]"); + Log('DXProt', "Merge request for $field[3] spots and $field[4] WWV from $field[2]"); # spots if ($field[3] > 0) { @@ -856,60 +904,12 @@ sub normal } if ($pcno == 34 || $pcno == 36) { # remote commands (incoming) - if ($field[1] eq $main::mycall) { - my $ref = DXUser->get_current($field[2]); - my $cref = Route::Node::get($field[2]); - Log('rcmd', 'in', $ref->{priv}, $field[2], $field[3]); - unless (!$cref || !$ref || $cref->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}; - $self->{priv} = $ref->{priv}; # assume the user's privilege level - my @in = (DXCommandmode::run_cmd($self, $field[3])); - $self->{priv} = $oldpriv; - for (@in) { - s/\s*$//og; - $self->send(pc35($main::mycall, $field[2], "$main::mycall:$_")); - Log('rcmd', 'out', $field[2], $_); - } - delete $self->{remotecmd}; - } else { - $self->send(pc35($main::mycall, $field[2], "$main::mycall:sorry...!")); - } - } else { - $self->send(pc35($main::mycall, $field[2], "$main::mycall:your attempt is logged, Tut tut tut...!")); - } - } else { - my $ref = DXUser->get_current($field[1]); - if ($ref && $ref->is_clx) { - $self->route($field[1], pc84($field[2], $field[1], $field[2], $field[3])); - } else { - $self->route($field[1], $line); - } - } + $self->process_rcmd($field[1], $field[2], $field[2], $field[3]); return; } if ($pcno == 35) { # remote command replies - if ($field[1] eq $main::mycall) { - my $s = $rcmds{$field[2]}; - if ($s) { - 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]); - if ($ref && $ref->is_clx) { - $self->route($field[1], pc85($field[2], $field[1], $field[2], $field[3])); - } else { - $self->route($field[1], $line); - } - } + $self->process_rcmd_reply($field[1], $field[2], $field[1], $field[3]); return; } @@ -922,6 +922,7 @@ sub normal if ($pcno == 39) { # incoming disconnect if ($field[1] eq $self->{call}) { $self->disconnect(1); + eph_del_regex("^PC(?:1[679]|21).*$field[1]"); } else { dbg("PCPROT: came in on wrong channel") if isdbg('chanerr'); } @@ -929,8 +930,18 @@ sub normal } if ($pcno == 41) { # user info - # add this station to the user database, if required my $call = $field[1]; + + # input filter if required +# my $ref = Route::get($call) || Route->new($call); +# return unless $self->in_filter_route($ref); + + if ($field[3] eq $field[2]) { + dbg('PCPROT: invalid value') if isdbg('chanerr'); + return; + } + + # add this station to the user database, if required my $user = DXUser->get_current($call); $user = DXUser->new($call) if !$user; @@ -939,22 +950,34 @@ sub normal } elsif ($field[2] == 2) { $user->qth($field[3]); } elsif ($field[2] == 3) { - 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); + if (is_latlong($field[3])) { + my ($lat, $long) = DXBearing::stoll($field[3]); + $user->lat($lat); + $user->long($long); + $user->qra(DXBearing::lltoqra($lat, $long)); + } else { + dbg('PCPROT: not a valid lat/long') if isdbg('chanerr'); + return; + } } elsif ($field[2] == 4) { $user->homenode($field[3]); + } elsif ($field[2] == 5) { + if (is_qra($field[3])) { + my ($lat, $long) = DXBearing::qratoll($field[3]); + $user->lat($lat); + $user->long($long); + $user->qra($field[3]); + } else { + dbg('PCPROT: not a valid QRA locator') if isdbg('chanerr'); + return; + } } $user->lastoper($main::systime); # to cut down on excessive for/opers being generated $user->put; - my $ref = Route::get($call) || Route->new($call); - - # input filter if required - return unless $self->in_filter_route($ref); - $self->route_pc41($ref, $call, $field[2], $field[3], $field[4]) if $ref && !eph_dup($line); - return; +# perhaps this IS what we want after all +# $self->route_pc41($ref, $call, $field[2], $field[3], $field[4]); +# return; } if ($pcno == 43) { @@ -985,6 +1008,7 @@ sub normal my $to = $field[1]; my $from = $field[2]; my $flag = $field[3]; + # is it for us? if ($to eq $main::mycall) { @@ -1020,6 +1044,10 @@ sub normal } } } else { + if (eph_dup($line)) { + dbg("PCPROT: dup PC51 detected") if isdbg('chanerr'); + return; + } # route down an appropriate thingy $self->route($to, $line); } @@ -1064,67 +1092,13 @@ sub normal } if ($pcno == 84) { # remote commands (incoming) - my $call = $field[1]; - if ($call eq $main::mycall) { - my $ref = DXUser->get_current($field[2]); - my $cref = Route::Node::get($field[2]); - Log('rcmd', 'in', $ref->{priv}, $field[2], $field[4]); - unless ($field[4] =~ /rcmd/i || !$cref || !$ref || $cref->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}; - $self->{priv} = $ref->{priv}; # assume the user's privilege level - my @in = (DXCommandmode::run_cmd($self, $field[4])); - $self->{priv} = $oldpriv; - for (@in) { - s/\s*$//og; - $self->send(pc85($main::mycall, $field[2], $field[3], "$main::mycall:$_")); - Log('rcmd', 'out', $field[2], $_); - } - delete $self->{remotecmd}; - } else { - $self->send(pc85($main::mycall, $field[2], $field[3], "$main::mycall:sorry...!")); - } - } else { - $self->send(pc85($main::mycall, $field[2], $field[3],"$main::mycall:your attempt is logged, Tut tut tut...!")); - } - } else { - my $ref = DXUser->get_current($call); - if ($ref && $ref->is_clx) { - $self->route($call, $line); - } else { - $self->route($call, pc34($field[2], $call, $field[4])); - } - } + $self->process_rcmd($field[1], $field[2], $field[3], $field[4]); return; } if ($pcno == 85) { # remote command replies - my $call = $field[1]; - if ($call eq $main::mycall) { - my $dxchan = DXChannel->get($field[3]); - if ($dxchan) { - $dxchan->send($field[4]); - } else { - my $s = $rcmds{$field[2]}; - if ($s) { - $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 { - my $ref = DXUser->get_current($call); - if ($ref && $ref->is_clx) { - $self->route($call, $line); - } else { - $self->route($call, pc35($field[2], $call, $field[4])); - } - } + $self->process_rcmd_reply($field[1], $field[2], $field[3], $field[4]); + return; } } @@ -1155,20 +1129,22 @@ sub process my $t = time; my @dxchan = DXChannel->get_all(); my $dxchan; + my $pc50s; + # send out a pc50 on EVERY channel all at once + if ($t >= $last_pc50 + $DXProt::pc50_interval) { + $pc50s = pc50($me, scalar DXChannel::get_all_users); + eph_dup($pc50s); + $last_pc50 = $t; + } + foreach $dxchan (@dxchan) { next unless $dxchan->is_node(); next if $dxchan == $me; - - # send a pc50 out on this channel - $dxchan->{pc50_t} = $main::systime unless exists $dxchan->{pc50_t}; - if ($t >= $dxchan->{pc50_t} + $DXProt::pc50_interval) { - my $s = pc50($me, scalar DXChannel::get_all_users); - eph_dup($s); - $dxchan->send($s); - $dxchan->{pc50_t} = $t; - } + # send the pc50 + $dxchan->send($pc50s) if $pc50s; + # send a ping out on this channel if ($dxchan->{pingint} && $t >= $dxchan->{pingint} + $dxchan->{lastping}) { if ($dxchan->{nopings} <= 0) { @@ -1214,7 +1190,7 @@ sub send_dx_spot # taking into account filtering and so on foreach $dxchan (@dxchan) { next if $dxchan == $me; - next if $dxchan == $self; + next if $dxchan == $self && $self->is_node; $dxchan->dx_spot($line, $self->{isolate}, @_, $self->{call}); } } @@ -1230,7 +1206,7 @@ sub dx_spot ($filter, $hops) = $self->{spotsfilter}->it(@_); return unless $filter; } - send_prot_line($self, $filter, $hops, $isolate, $line) + send_prot_line($self, $filter, $hops, $isolate, $line); } sub send_prot_line @@ -1243,10 +1219,10 @@ sub send_prot_line $routeit =~ s/\^H\d+\^\~$/\^H$hops\^\~/; } else { $routeit = adjust_hops($self, $line); # adjust its hop count by node name - next unless $routeit; + return unless $routeit; } if ($filter) { - $self->send($routeit) if $routeit; + $self->send($routeit); } else { $self->send($routeit) unless $self->{isolate} || $isolate; } @@ -1276,8 +1252,8 @@ sub send_wwv_spot # send it if it isn't the except list and isn't isolated and still has a hop count # taking into account filtering and so on foreach $dxchan (@dxchan) { - next if $dxchan == $self; next if $dxchan == $me; + next if $dxchan == $self && $self->is_node; my $routeit; my ($filter, $hops); @@ -1388,12 +1364,9 @@ sub send_announce # send it if it isn't the except list and isn't isolated and still has a hop count # taking into account filtering and so on foreach $dxchan (@dxchan) { - next if $dxchan == $self; next if $dxchan == $me; - my $routeit; - my ($filter, $hops); - - $dxchan->announce($line, $self->{isolate}, $to, $target, $text, @_, $self->{call}, $ann_dxcc, $ann_itu, $ann_cq, $org_dxcc, $org_itu, $org_cq) + next if $dxchan == $self && $self->is_node; + $dxchan->announce($line, $self->{isolate}, $to, $target, $text, @_, $self->{call}, $ann_dxcc, $ann_itu, $ann_cq, $org_dxcc, $org_itu, $org_cq); } } @@ -1404,6 +1377,7 @@ sub announce my $isolate = shift; my $to = shift; my $target = shift; + my $text = shift; my ($filter, $hops); if ($self->{annfilter}) { @@ -1431,7 +1405,7 @@ sub send_local_config # create a list of all the nodes that are not connected to this connection # and are not themselves isolated, this to make sure that isolated nodes # don't appear outside of this node - my @dxchan = grep { $_->call ne $main::mycall && $_->call ne $self->{call} } DXChannel::get_all_nodes(); + my @dxchan = grep { $_->call ne $main::mycall && $_ != $self && !$_->{isolate} } DXChannel::get_all_nodes(); @localnodes = map { my $r = Route::Node::get($_->{call}); $r ? $r : () } @dxchan if @dxchan; my @intcalls = map { $_->nodes } @localnodes if @localnodes; my $ref = Route::Node::get($self->{call}); @@ -1651,6 +1625,81 @@ sub addping $pings{$to} = $ref; } +sub process_rcmd +{ + my ($self, $tonode, $fromnode, $user, $cmd) = @_; + if ($tonode eq $main::mycall) { + my $ref = DXUser->get_current($fromnode); + my $cref = Route::Node::get($fromnode); + Log('rcmd', 'in', $ref->{priv}, $fromnode, $cmd); + if ($cmd !~ /^\s*rcmd/i && $cref && $ref && $cref->call eq $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}; + $self->{priv} = $ref->{priv}; # assume the user's privilege level + my @in = (DXCommandmode::run_cmd($self, $cmd)); + $self->{priv} = $oldpriv; + $self->send_rcmd_reply($main::mycall, $fromnode, $user, @in); + delete $self->{remotecmd}; + } else { + $self->send_rcmd_reply($main::mycall, $fromnode, $user, "sorry...!"); + } + } else { + $self->send_rcmd_reply($main::mycall, $fromnode, $user, "your attempt is logged, Tut tut tut...!"); + } + } else { + my $ref = DXUser->get_current($tonode); + if ($ref && $ref->is_clx) { + $self->route($tonode, pc84($fromnode, $tonode, $user, $cmd)); + } else { + $self->route($tonode, pc34($fromnode, $tonode, $cmd)); + } + } +} + +sub process_rcmd_reply +{ + my ($self, $tonode, $fromnode, $user, $line) = @_; + if ($tonode eq $main::mycall) { + my $s = $rcmds{$fromnode}; + if ($s) { + my $dxchan = DXChannel->get($s->{call}); + my $ref = $user eq $tonode ? $dxchan : (DXChannel->get($user) || $dxchan); + $ref->send($line) if $ref; + delete $rcmds{$fromnode} if !$dxchan; + } else { + # send unsolicited ones to the sysop + my $dxchan = DXChannel->get($main::myalias); + $dxchan->send($line) if $dxchan; + } + } else { + my $ref = DXUser->get_current($tonode); + if ($ref && $ref->is_clx) { + $self->route($tonode, pc85($fromnode, $tonode, $user, $line)); + } else { + $self->route($tonode, pc35($fromnode, $tonode, $line)); + } + } +} + +sub send_rcmd_reply +{ + my $self = shift; + my $tonode = shift; + my $fromnode = shift; + my $user = shift; + while (@_) { + my $line = shift; + $line =~ s/\s*$//; + Log('rcmd', 'out', $fromnode, $line); + if ($self->is_clx) { + $self->send(pc85($main::mycall, $fromnode, $user, "$main::mycall:$line")); + } else { + $self->send(pc35($main::mycall, $fromnode, "$main::mycall:$line")); + } + } +} + # add a rcmd request to the rcmd queues sub addrcmd { @@ -1685,7 +1734,6 @@ sub disconnect my $node = Route::Node::get($call); my @rout; if ($node) { - @rout = $node->del_nodes; # at the next level @rout = $node->del($main::routeroot); } @@ -1764,7 +1812,7 @@ sub send_route $routeit = adjust_hops($self, $line); # adjust its hop count by node name next unless $routeit; } - $self->send($routeit) if $self->{routefilter} || !$self->{isolate}; + $self->send($routeit); } } } @@ -1780,10 +1828,10 @@ sub broadcast_route foreach $dxchan (@dxchan) { next if $dxchan == $self; next if $dxchan == $me; - if ($dxchan->{routefilter} || !$self->{isolate}) { - $dxchan->send_route($generate, @_) + if ($dxchan->{routefilter}) { + $dxchan->send_route($generate, @_); } else { - dbg('DXPROT: isolated') if isdbg('chanerr'); + $dxchan->send_route($generate, @_) unless $self->{isolate} || $dxchan->{isolate}; } } } @@ -1848,12 +1896,23 @@ sub eph_dup my $s = shift; # chop the end off - $s =~ s/\^H\d\d?\^?~?$//; + $s =~ s/\^H\d\d?\^?\~?$//; return 1 if exists $eph{$s}; $eph{$s} = $main::systime; return undef; } +sub eph_del_regex +{ + my $regex = shift; + my ($key, $val); + while (($key, $val) = each %eph) { + if ($key =~ m{$regex}) { + delete $eph{$key}; + } + } +} + sub eph_clean { my ($key, $val);