X-Git-Url: http://gb7djk.dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXProt.pm;h=ac675f7cafefa6496064a65172c27a9a6bc32e88;hb=ceb2daf21a03249decadc86f4b90711fe8a53b0e;hp=72f411949861f581e7567d1edcb4203d00fe0164;hpb=2292ddaa6a89373d07cbe9e6f235ab2bb45b1e92;p=spider.git diff --git a/perl/DXProt.pm b/perl/DXProt.pm index 72f41194..ac675f7c 100644 --- a/perl/DXProt.pm +++ b/perl/DXProt.pm @@ -33,6 +33,10 @@ use Route; use Route::Node; use Script; use DXProtHandle; +use DXCIDR; + +use Time::HiRes qw(gettimeofday tv_interval); +use DXSubprocess; use strict; @@ -46,7 +50,7 @@ use vars qw($pc11_max_age $pc23_max_age $last_pc50 $eph_restime $eph_info_restim %pc92_find $pc92_find_timeout $pc92_short_update_period $next_pc92_obs_timeout $pc92_slug_changes $last_pc92_slug $pc92_extnode_update_period $pc50_interval - $pc92_keepalive_period + $pc92_keepalive_period $senderverify ); $pc11_max_age = 1*3600; # the maximum age for an incoming 'real-time' pc11 @@ -79,6 +83,8 @@ $pc92_extnode_update_period = 1*60*60; # the update period for external nodes $pc92_keepalive_period = 1*60*60; # frequency of PC92 K (keepalive) records %pc92_find = (); # outstanding pc92 find operations $pc92_find_timeout = 30; # maximum time to wait for a reply +$senderverify = 0; # 1 = check spotter is on node it says it is and check ip address if available + # 2 = do 1 and dump if check @checklist = @@ -134,7 +140,7 @@ $pc92_find_timeout = 30; # maximum time to wait for a reply undef, undef, undef, # pc60 - undef, + [ qw(i f m d t m c c a h) ], # pc61 undef, undef, undef, @@ -174,6 +180,8 @@ $pc92_find_timeout = 30; # maximum time to wait for a reply sub check { my $n = shift; + my $pc = shift; + $n -= 10; return 0 if $n < 0 || $n > @checklist; my $ref = $checklist[$n]; @@ -183,28 +191,30 @@ sub check for ($i = 1; $i < @$ref; $i++) { my ($blank, $act) = $$ref[$i] =~ /^(b?)(\w)$/; return 0 unless $act; - next if $blank eq 'b' && $_[$i] =~ /^[ \*]$/; - next if $blank eq '*' && $_[$i] =~ /^\*$/; + next if $blank eq 'b' && $pc->[$i] =~ /^[ \*]$/; + next if $blank eq '*' && $pc->[$i] =~ /^\*$/; if ($act eq 'c') { - return $i unless is_callsign($_[$i]); + return $i unless is_callsign($pc->[$i]); } elsif ($act eq 'i') { ; # do nothing } elsif ($act eq 'm') { - return $i unless is_pctext($_[$i]); + return $i unless is_pctext($pc->[$i]); } elsif ($act eq 'p') { - return $i unless is_pcflag($_[$i]); + return $i unless is_pcflag($pc->[$i]); } elsif ($act eq 'f') { - return $i unless is_freq($_[$i]); + return $i unless is_freq($pc->[$i]); } elsif ($act eq 'n') { - return $i unless $_[$i] =~ /^[\d ]+$/; + return $i unless $pc->[$i] =~ /^[\d ]+$/; } elsif ($act eq 'h') { - return $i unless $_[$i] =~ /^H\d\d?$/; + return $i unless $pc->[$i] =~ /^H\d\d?$/; } elsif ($act eq 'd') { - return $i unless $_[$i] =~ /^\s*\d+-\w\w\w-[12][90]\d\d$/; + return $i unless $pc->[$i] =~ /^\s*\d+-\w\w\w-[12][90]\d\d$/; } elsif ($act eq 't') { - return $i unless $_[$i] =~ /^[012]\d[012345]\dZ$/; + return $i unless $pc->[$i] =~ /^[012]\d[012345]\dZ$/; } elsif ($act eq 'l') { - return $i unless $_[$i] =~ /^[A-Z]$/; + return $i unless $pc->[$i] =~ /^[A-Z]$/; + } elsif ($act eq 'a') { + return $i unless is_ipaddr($pc->[$i]); } } return 0; @@ -228,7 +238,8 @@ sub update_pc92_keepalive sub init { - do "$main::data/hop_table.pl" if -e "$main::data/hop_table.pl"; + my $fn = localdata("hop_table.pl"); + do $fn if -e $fn; confess $@ if $@; my $user = DXUser::get($main::mycall); @@ -244,8 +255,9 @@ sub init $main::me->{pingave} = 0; $main::me->{registered} = 1; $main::me->{version} = $main::version; - $main::me->{build} = "$main::subversion.$main::build"; + $main::me->{build} = $main::build; $main::me->{do_pc9x} = 1; + $main::me->{hostname} = $main::clusteraddr; $main::me->update_pc92_next($pc92_short_update_period); $main::me->update_pc92_keepalive; } @@ -286,8 +298,9 @@ sub start # log it my $host = $self->{conn}->peerhost; $host ||= "AGW Port #$self->{conn}->{agwport}" if exists $self->{conn}->{agwport}; + $host ||= $host if is_ipaddr($host); $host ||= "unknown"; - + $self->{hostname} = $host if is_ipaddr($host); Log('DXProt', "$call connected from $host"); # remember type of connection @@ -399,7 +412,7 @@ sub normal } # check for and dump bad protocol messages - my $n = check($pcno, @field); + my $n = check($pcno, \@field); if ($n) { dbg("PCPROT: bad field $n, dumped (" . parray($checklist[$pcno-10]) . ")") if isdbg('chanerr'); return; @@ -416,21 +429,22 @@ sub normal } } + my $origin = $self->{call}; + if (defined &Local::pcprot) { my $r; - eval { $r = Local::pcprot($self, $pcno, $line, @field); }; + eval { $r = Local::pcprot($self, $pcno, $line, $origin, \@field); }; return if $r; # i.e don't process it } # send it out for processing - my $origin = $self->{call}; no strict 'subs'; my $sub = "handle_$pcno"; if ($self->can($sub)) { - $self->$sub($pcno, $line, $origin, @field); + $self->$sub($pcno, $line, $origin, \@field); } else { - $self->handle_default($pcno, $line, $origin, @field); + $self->handle_default($pcno, $line, $origin, \@field); } } @@ -527,6 +541,8 @@ sub process if ($main::systime - 3600 > $last_hour) { $last_hour = $main::systime; } + + pc11_process(); } # @@ -544,14 +560,24 @@ sub send_dx_spot my $line = shift; my @dxchan = DXChannel::get_all(); my $dxchan; + my $pc11; # 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 == $main::me; next if $dxchan == $self && $self->is_node; - next if $line =~ /PC61/ && !$dxchan->is_spider && !$dxchan->is_user; - $dxchan->dx_spot($line, $self->{isolate}, @_, $self->{call}); + next if $dxchan == $self; + next if $dxchan->is_rbn; + if ($line =~ /PC61/ && !($dxchan->is_spider || $dxchan->is_user)) { + unless ($pc11) { + my @f = split /\^/, $line; + $pc11 = join '^', 'PC11', @f[1..7,9]; + } + $dxchan->dx_spot($pc11, $self->{isolate}, @_, $self->{call}); + } else { + $dxchan->dx_spot($line, $self->{isolate}, @_, $self->{call}); + } } } @@ -603,6 +629,7 @@ sub send_wwv_spot foreach $dxchan (@dxchan) { next if $dxchan == $main::me; next if $dxchan == $self && $self->is_node; + next if $dxchan->is_rbn; my $routeit; my ($filter, $hops); @@ -637,6 +664,7 @@ sub send_wcy_spot foreach $dxchan (@dxchan) { next if $dxchan == $main::me; next if $dxchan == $self; + next if $dxchan->is_rbn; $dxchan->wcy($line, $self->{isolate}, @_, $self->{call}, @dxcc); } @@ -712,6 +740,7 @@ sub send_announce } Log('ann', $target, $from, $text); + AnnTalk::add_anncache('ann', $target, $from, $text); # 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 @@ -720,6 +749,7 @@ sub send_announce next if $dxchan == $self && $self->is_node; next if $from_pc9x && $dxchan->{do_pc9x}; next if $target eq 'LOCAL' && $dxchan->is_node; + next if $dxchan->is_rbn; $dxchan->announce($line, $self->{isolate}, $to, $target, $text, @_, $self->{call}, @a[0..2], @b[0..2]); } @@ -785,20 +815,16 @@ sub send_chat # 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) { - my $is_ak1a = $dxchan->is_ak1a; - if ($dxchan->is_node) { next if $dxchan == $main::me; next if $dxchan == $self; - next if $from_pc9x && $dxchan->{do_pc9x}; - next unless $dxchan->is_spider || $is_ak1a; + next if $from_pc9x && $dxchan->do_pc9x; + next unless $dxchan->is_spider && $dxchan->do_pc9x; next if $target eq 'LOCAL'; - if (!$ak1a_line && $is_ak1a) { - $ak1a_line = pc12($_[0], $text, $_[1], "$target.LST"); - } } + next if $dxchan->is_rbn; - $dxchan->chat($is_ak1a ? $ak1a_line : $line, $self->{isolate}, $target, $_[1], + $dxchan->chat($line, $self->{isolate}, $target, $_[1], $text, @_, $self->{call}, @a[0..2], @b[0..2]); } } @@ -853,11 +879,11 @@ sub send_local_config my @remotenodes; if ($self->{isolate}) { - dbg("send_local_config: isolated"); + dbg("$self->{call} send_local_config: isolated"); @localnodes = ( $main::routeroot ); $self->send_route($main::mycall, \&pc19, 1, $main::routeroot); } elsif ($self->{do_pc9x}) { - dbg("send_local_config: doing pc9x"); + dbg("$self->{call} send_local_config: doing pc9x"); my $node = Route::Node::get($self->{call}); # $self->send_last_pc92_config($main::routeroot); # $self->send(pc92a($main::routeroot, $node)) unless $main::routeroot->last_PC92C =~ /$self->{call}/; @@ -868,7 +894,7 @@ sub send_local_config # and are not themselves isolated, this to make sure that isolated nodes # don't appear outside of this node - dbg("send_local_config: traditional"); + dbg("$self->{call} send_local_config: traditional"); # send locally connected nodes my @dxchan = grep { $_->call ne $main::mycall && $_ != $self && !$_->{isolate} } DXChannel::get_all_nodes(); @@ -910,7 +936,7 @@ sub gen_my_pc92_config clear_pc92_changes(); # remove any slugged data, we are generating it as now my @dxchan = grep { $_->call ne $main::mycall && !$_->{isolate} } DXChannel::get_all(); dbg("ROUTE: all dxchan: " . join(',', map{$_->{call}} @dxchan)) if isdbg('routelow'); - my @localnodes = map { my $r = Route::get($_->{call}); $r ? $r : () } @dxchan; + my @localnodes = map { my $r = Route::get($_->{call}); ($_->is_node || $_->is_user) && $r ? $r : () } @dxchan; dbg("ROUTE: localnodes: " . join(',', map{$_->{call}} @localnodes)) if isdbg('routelow'); return pc92c($node, @localnodes); } else { @@ -950,7 +976,8 @@ sub broadcast_pc92_update my $nref = Route::Node::get($call); unless ($nref) { - dbg("ERROR: broadcast_pc92_update - Route::Node $call disappeared"); + cluck("ERROR: broadcast_pc92_update - Route::Node $call disappeared"); + $self->update_pc92_next; return; } my $l = $nref->last_PC92C(gen_my_pc92_config($nref)); @@ -968,7 +995,8 @@ sub broadcast_pc92_keepalive my $nref = Route::Node::get($call); unless ($nref) { - dbg("ERROR: broadcast_pc92_keepalive - Route::Node $call disappeared"); + cluck("ERROR: broadcast_pc92_keepalive - Route::Node $call disappeared"); + $self->update_pc92_keepalive; return; } my $l = pc92k($nref); @@ -1054,7 +1082,7 @@ sub get_hops { my $pcno = shift; my $hops = $DXProt::hopcount{$pcno}; - $hops = $DXProt::def_hopcount if !$hops; + $hops = $DXProt::def_hopcount unless $hops; return "H$hops"; } @@ -1104,16 +1132,33 @@ sub load_hops sub process_rcmd { my ($self, $tonode, $fromnode, $user, $cmd) = @_; + if ($tonode eq $main::mycall) { my $ref = DXUser::get_current($fromnode); + unless ($ref && UNIVERSAL::isa($ref, 'DXUser')) { + dbg("DXProt process_rcmd: user $fromnode isn't a reference (check user_asc and tell G1TLH)"); + $self->send_rcmd_reply($main::mycall, $fromnode, $user, "sorry...!"); + return; + } + Log('rcmd', 'in', ($ref->{priv}||0), $fromnode, $cmd, $user); my $cref = Route::Node::get($fromnode); - Log('rcmd', 'in', ($ref->{priv}||0), $fromnode, $cmd); - if ($cmd !~ /^\s*rcmd/i && $cref && $ref && $ref->homenode && $cref->call eq $ref->homenode) { # not allowed to relay RCMDS! + unless ($cref && UNIVERSAL::isa($cref, 'Route')) { + dbg("DXProt process_rcmd: Route $fromnode isn't a reference (tell G1TLH)"); + $self->send_rcmd_reply($main::mycall, $fromnode, $user, "sorry...!"); + return; + } + if ($cmd !~ /^\s*rcmd/i && $ref->homenode && $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 + $self->{priv} = 1; # set a maximum privilege + + # park homenode and user for any spawned command that run_cmd may do. + $self->{_rcmd_user} = $user; + $self->{_rcmd_fromnode} = $fromnode; my @in = (DXCommandmode::run_cmd($self, $cmd)); + delete $self->{_rcmd_fromnode}; + delete $self->{_rcmd_user}; $self->{priv} = $oldpriv; $self->send_rcmd_reply($main::mycall, $fromnode, $user, @in); delete $self->{remotecmd}; @@ -1133,6 +1178,119 @@ sub process_rcmd } } + +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, $user); + if ($self->is_clx) { + $self->send(pc85($main::mycall, $fromnode, $user, "$main::mycall:$line")); + } else { + $self->send(pc35($main::mycall, $fromnode, "$main::mycall:$line")); + } + } +} + +# Punt off a long running command into a separate process - this will be caused by an rcmd from outside +# +# This is called from commands to run some potentially long running +# function. The process forks and then runs the function and returns +# the result back to the cmd. +# +# NOTE: this merely forks the current process and then runs the cmd in that (current) context. +# IT DOES NOT START UP SOME NEW PROGRAM AND RELIES ON THE FACT THAT IT IS RUNNING DXSPIDER +# THE CURRENT CONTEXT!! +# +# call: $self->spawn_cmd($original_cmd_line, \, [cb => sub{...}], [prefix => "cmd> "], [progress => 0|1], [args => [...]]); +sub spawn_cmd +{ + my $self = shift; + my $line = shift; + my $cmdref = shift; + my $call = $self->{call}; + my %args = @_; + my @out; + + my $cb = delete $args{cb}; + my $prefix = delete $args{prefix}; + my $progress = delete $args{progress}; + my $args = delete $args{args} || []; + my $t0 = [gettimeofday]; + + # remembered from process_cmd when spawn_cmd was called thru DXCommandmode::run_cmd which was called by process_rcmd + my $fromnode = $self->{_rcmd_fromnode}; + my $user = $self->{_rcmd_user}; + + no strict 'refs'; + + my $fc = DXSubprocess->new; + + # just behave normally if something has set the "one-shot" _nospawn in the channel + if ($self->{_nospawn}) { + eval { @out = $cmdref->(@$args); }; + if ($@) { + DXDebug::dbgprintring(25); + push @out, DXDebug::shortmess($@); + } + return @out; + } + + # $fc->serializer(\&encode_json); +# $fc->deserializer(\&decode_json); + $fc->run( + sub { + my $subpro = shift; + if (isdbg('progress')) { + my $s = qq{line: "$line"}; + $s .= ", args: " . join(', ', map { defined $_ ? qq{'$_'} : q{'undef'} } @$args) if $args && @$args; + dbg($s); + } + eval { @out = $cmdref->(@$args); }; + if ($@) { + DXDebug::dbgprintring(25); + push @out, DXDebug::shortmess($@); + } + return @out; + }, +# $args, + sub { + my ($fc, $err, @res) = @_; + my $self = DXChannel::get($call); + return unless $self; + + if ($err) { + my $s = "DXCommand::spawn_cmd: call $call error $err"; + dbg($s) if isdbg('chan'); + if ($fromnode && $user) { + $self->send_rcmd_reply($main::mycall, $fromnode, $user, $s); + } else { + $self->send($s); + } + return; + } + if ($cb) { + # transform output if required + @res = $cb->($self, @res); + } + if (@res) { + if ($fromnode && $user) { + $self->send_rcmd_reply($main::mycall, $fromnode, $user, @res); + } else { + $self->send(@res); + } + } + diffms("rcmd from $user on $call", $line, $t0, scalar @res) if isdbg('progress'); + }); + + return @out; +} + sub process_rcmd_reply { my ($self, $tonode, $fromnode, $user, $line) = @_; @@ -1158,23 +1316,7 @@ sub process_rcmd_reply } } -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 @@ -1638,6 +1780,8 @@ sub import_chat my $via = $target; $via = '*' if $target eq 'ALL' || $target eq 'SYSOP'; Log('ann', $target, $main::mycall, $text); + AnnTalk::add_anncache('ann', $target, $main::mycall, $text); + $main::me->normal(DXProt::pc93($target, $main::mycall, $via, $text)); } else { DXCommandmode::send_chats($main::me, $target, $text); @@ -1669,5 +1813,8 @@ sub clean_pc92_find { } + + + 1; __END__