X-Git-Url: http://gb7djk.dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXProt.pm;h=8b9026c1f700e71945feda5329efcf9b2b431f95;hb=refs%2Fheads%2Fnew-spawn;hp=1cee4da0fd6006ad1e3c9cdef6fb1a94d33a16ef;hpb=937b3f6592ae13be16dfe171b30817ee39d27bf0;p=spider.git diff --git a/perl/DXProt.pm b/perl/DXProt.pm index 1cee4da0..8b9026c1 100644 --- a/perl/DXProt.pm +++ b/perl/DXProt.pm @@ -32,9 +32,11 @@ use DXHash; use Route; use Route::Node; use Script; -use RouteDB; use DXProtHandle; +use Time::HiRes qw(gettimeofday tv_interval); +use Mojo::IOLoop::Subprocess; + use strict; use vars qw($pc11_max_age $pc23_max_age $last_pc50 $eph_restime $eph_info_restime $eph_pc34_restime @@ -66,15 +68,15 @@ $badnode = new DXHash "badnode"; $last10 = $last_pc50 = time; $ann_to_talk = 1; $eph_restime = 60; -$eph_info_restime = 60*60; +$eph_info_restime = 18*60*60; $eph_pc15_restime = 6*60; $eph_pc34_restime = 30; $pingint = 5*60; $obscount = 2; $chatdupeage = 20 * 60; $chatimportfn = "$main::root/chat_import"; -$pc19_version = 5454; # the visible version no for outgoing PC19s generated from pc59 -$pc92_update_period = 2*60*60; # the period between outgoing PC92 C updates +$pc19_version = 5455; # the visible version no for outgoing PC19s generated from pc59 +$pc92_update_period = 4*60*60; # the period between outgoing PC92 C updates $pc92_short_update_period = 15*60; # shorten the update period after a connection or start up $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 @@ -135,7 +137,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, @@ -175,6 +177,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]; @@ -184,28 +188,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; @@ -229,10 +235,11 @@ 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); + my $user = DXUser::get($main::mycall); die "User $main::mycall not setup or disappeared RTFM" unless $user; $myprot_version += $main::version*100; @@ -245,7 +252,7 @@ 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->update_pc92_next($pc92_short_update_period); $main::me->update_pc92_keepalive; @@ -270,7 +277,7 @@ sub new my @rout = $ref->delete; $self->route_pc21($main::mycall, undef, @rout) if @rout; } - $main::routeroot->add($call, '5000', Route::here(1)) if $call ne $main::mycall; + $main::routeroot->add($call, '5000', Route::here(1), $self->{conn}->peerhost) if $call ne $main::mycall; return $self; } @@ -285,9 +292,10 @@ sub start my $user = $self->{user}; # log it - my $host = $self->{conn}->{peerhost}; + my $host = $self->{conn}->peerhost; $host ||= "AGW Port #$self->{conn}->{agwport}" if exists $self->{conn}->{agwport}; $host ||= "unknown"; + $self->{hostname} = $host if is_ipaddr($host); Log('DXProt', "$call connected from $host"); @@ -295,7 +303,7 @@ sub start $self->{consort} = $line; $self->{outbound} = $sort eq 'O'; my $priv = $user->priv; - $priv = $user->priv(1) unless $priv; + $priv = $user->priv(1) unless defined $priv; $self->{priv} = $priv; # other clusters can always be 'normal' users $self->{lang} = $user->lang || 'en'; $self->{isolate} = $user->{isolate}; @@ -311,7 +319,8 @@ sub start $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) unless $self->{isolate} ; + $self->{routefilter} = Filter::read_in('route', $call, 0) || Filter::read_in('route', 'node_default', 0) unless $self->{isolate}; + $self->{pc92filter} = Filter::read_in('pc92', $call, 0) || Filter::read_in('pc92', 'node_default', 0) unless $self->{isolate} ; # get the INPUT filters (these only pertain to Clusters) @@ -320,12 +329,8 @@ sub start $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) unless $self->{isolate}; - # if there is no route input filter then specify a default one. - # obviously this can be changed later by the sysop. - if (!$self->{inroutefilter}) { - my $dxcc = $self->dxcc; - $Route::filterdef->cmd($self, 'route', 'accept', "input by_dxcc $dxcc" ); - } + $self->{inpc92filter} = Filter::read_in('pc92', $call, 0) || Filter::read_in('pc92', 'node_default', 0) unless $self->{isolate} ; + # set unbuffered and no echo $self->send_now('B',"0"); @@ -403,7 +408,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; @@ -420,15 +425,21 @@ sub normal } } + if (defined &Local::pcprot) { + my $r; + eval { $r = Local::pcprot($self, $pcno, $line, @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); } } @@ -457,12 +468,10 @@ sub process $pc50s = pc50($main::me, scalar DXChannel::get_all_users); eph_dup($pc50s); $last_pc50 = $t; - time_out_pc92_routes(); } foreach $dxchan (@dxchan) { next unless $dxchan->is_node; - next if $dxchan->handle_xml; next if $dxchan == $main::me; # send the pc50 @@ -471,12 +480,14 @@ sub process # send a ping out on this channel if ($dxchan->{pingint} && $t >= $dxchan->{pingint} + $dxchan->{lastping}) { if ($dxchan->{nopings} <= 0) { + dbg("ROUTE: $dxchan->{call} disconnected on ping obscount") if isdbg('obscount'); $dxchan->disconnect; } else { DXXml::Ping::add($main::me, $dxchan->call); $dxchan->{nopings} -= 1; $dxchan->{lastping} = $t; $dxchan->{lastping} += $dxchan->{pingint} / 2 unless @{$dxchan->{pingtime}}; + dbg("ROUTE: $dxchan->{call} ping obscount = $dxchan->{nopings}") if isdbg('obscount'); } } } @@ -506,22 +517,12 @@ sub process $dxchan->update_pc92_next; # this won't actually do anything, it's just to be tidy } } + } - # do the keepalives in the same way, but use a different timer - if ($main::systime >= $dxchan->{next_pc92_keepalive}) { - if ($dxchan == $main::me || !$dxchan->{do_pc9x}) { - dbg("ROUTE: pc92 keepalive candidate: $dxchan->{call}") if isdbg('obscount'); - my $ref = Route::Node::get($dxchan->{call}); - if ($dxchan == $main::me || ($ref && ($ref->measure_pc9x_t($main::systime-$main::systime_daystart)) >= $pc92_keepalive_period/2)) { - $dxchan->broadcast_pc92_keepalive($dxchan->{call}); - } else { - $dxchan->update_pc92_keepalive; - } - } else { -# $dxchan->update_pc92_next; # this won't actually do anything, it's just to be tidy - $dxchan->update_pc92_keepalive; - } - } + # do the keepalive for me, if required + if ($main::systime >= $main::me->{next_pc92_keepalive}) { + time_out_pc92_routes(); + $main::me->broadcast_pc92_keepalive($main::mycall); } if ($pc92_slug_changes && $main::systime >= $last_pc92_slug + $pc92_slug_changes) { @@ -552,13 +553,22 @@ 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; - $dxchan->dx_spot($line, $self->{isolate}, @_, $self->{call}); + 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}); + } } } @@ -792,20 +802,15 @@ 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"); - } } - $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]); } } @@ -866,8 +871,10 @@ sub send_local_config } elsif ($self->{do_pc9x}) { dbg("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}/; +# $self->send_last_pc92_config($main::routeroot); +# $self->send(pc92a($main::routeroot, $node)) unless $main::routeroot->last_PC92C =~ /$self->{call}/; + $self->send(pc92a($main::routeroot, $node)); + $self->send(pc92k($main::routeroot)); } else { # 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 @@ -955,7 +962,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)); @@ -973,7 +981,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); @@ -1041,19 +1050,6 @@ sub route } } - # try the backstop method - unless ($dxchan) { - my $rcall = RouteDB::get($call); - if ($rcall) { - if ($self && $rcall eq $self->{call}) { - dbg("PCPROT: Trying to route back to source, dropped") if isdbg('chanerr'); - return; - } - $dxchan = DXChannel::get($rcall); - dbg("route: $call -> $rcall using RouteDB" ) if isdbg('route') && $dxchan; - } - } - if ($dxchan) { my $routeit = adjust_hops($dxchan, $line); # adjust its hop count by node name if ($routeit) { @@ -1123,15 +1119,31 @@ sub process_rcmd { my ($self, $tonode, $fromnode, $user, $cmd) = @_; if ($tonode eq $main::mycall) { - my $ref = DXUser->get_current($fromnode); + 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; + } 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! + 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; + } + Log('rcmd', 'in', ($ref->{priv}||0), $fromnode, $cmd); + 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}; @@ -1142,7 +1154,7 @@ sub process_rcmd $self->send_rcmd_reply($main::mycall, $fromnode, $user, "your attempt is logged, Tut tut tut...!"); } } else { - my $ref = DXUser->get_current($tonode); + my $ref = DXUser::get_current($tonode); if ($ref && $ref->is_clx) { $self->route($tonode, pc84($fromnode, $tonode, $user, $cmd)); } else { @@ -1151,6 +1163,108 @@ 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); + 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 = Mojo::IOLoop::Subprocess->new; + + # just behave normally if something has set the "one-shot" _nospawn in the channel + return ($cmdref->(@$args)) if $self->{_nospawn}; + + # $fc->serializer(\&encode_json); +# $fc->deserializer(\&decode_json); + $fc->run( + sub { + my $subpro = shift; + if (isdbg('chan')) { + my $s = "line: $line"; + $s .= ", args: " . join(', ', @$args) if $args && @$args; + } + + my @res = $cmdref->(@$args); + return @res; + }, +# $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); + } + } + DXCommandmode::_diffms($call, $line, $t0); + }); + + return @out; +} + sub process_rcmd_reply { my ($self, $tonode, $fromnode, $user, $line) = @_; @@ -1167,7 +1281,7 @@ sub process_rcmd_reply $dxchan->send($line) if $dxchan; } } else { - my $ref = DXUser->get_current($tonode); + my $ref = DXUser::get_current($tonode); if ($ref && $ref->is_clx) { $self->route($tonode, pc85($fromnode, $tonode, $user, $line)); } else { @@ -1176,23 +1290,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 @@ -1217,12 +1315,12 @@ sub addrcmd sub disconnect { my $self = shift; - my $pc39flag = shift; + my $pc39flag = shift || 0; my $call = $self->call; return if $self->{disconnecting}++; - unless ($pc39flag && $pc39flag == 1) { + unless ($pc39flag == 1) { $self->send_now("D", DXProt::pc39($main::mycall, $self->msg('disc1', "System Op"))); } @@ -1232,7 +1330,7 @@ sub disconnect # do routing stuff, remove me from routing table my $node = Route::Node::get($call); - RouteDB::delete_interface($call); + Route::delete_interface($call); # unbusy and stop and outgoing mail my $mref = DXMsg::get_busy($call); @@ -1283,7 +1381,7 @@ sub disconnect } # broadcast to all other nodes that all the nodes connected to via me are gone - unless ($pc39flag && $pc39flag == 2) { + unless ($pc39flag == 2) { $self->route_pc21($main::mycall, undef, @rout) if @rout; $self->route_pc92d($main::mycall, undef, $main::routeroot, $node) if $node; } @@ -1687,5 +1785,8 @@ sub clean_pc92_find { } + + + 1; __END__