X-Git-Url: http://dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXProt.pm;h=67dc56632d80b4d2e06abcb509daa2d239c7c71e;hb=8467e0bbd9951b6b2395e832c7f54f78f5fff8cc;hp=5a88a2d4d5f6bdcdbf2234aca329df7cf899588f;hpb=5e61d31d9f317fcef97a66e1ac1944cb17b42eec;p=spider.git diff --git a/perl/DXProt.pm b/perl/DXProt.pm index 5a88a2d4..67dc5663 100644 --- a/perl/DXProt.pm +++ b/perl/DXProt.pm @@ -32,8 +32,11 @@ use DXHash; use Route; use Route::Node; use Script; -use RouteDB; use DXProtHandle; +use DXCIDR; + +use Time::HiRes qw(gettimeofday tv_interval); +use DXSubprocess; use strict; @@ -47,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 @@ -66,20 +69,22 @@ $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 +$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 %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 = @@ -135,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, @@ -175,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]; @@ -184,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; @@ -229,10 +238,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,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; } @@ -270,7 +281,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,17 +296,18 @@ 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 ||= $host if is_ipaddr($host); $host ||= "unknown"; - + $self->{hostname} = $host if is_ipaddr($host); Log('DXProt', "$call connected from $host"); # remember type of connection $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 +323,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 +333,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 +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; @@ -420,15 +429,22 @@ sub normal } } - # send it out for processing my $origin = $self->{call}; + + if (defined &Local::pcprot) { + my $r; + eval { $r = Local::pcprot($self, $pcno, $line, $origin, \@field); }; + return if $r; # i.e don't process it + } + + # send it out for processing 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); } } @@ -525,6 +541,8 @@ sub process if ($main::systime - 3600 > $last_hour) { $last_hour = $main::systime; } + + pc11_process(); } # @@ -542,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}); + } } } @@ -601,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); @@ -635,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); } @@ -710,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 @@ -718,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]); } @@ -783,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]); } } @@ -851,20 +879,22 @@ 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}/; +# $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 # 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(); @@ -906,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 { @@ -946,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)); @@ -964,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); @@ -1032,19 +1064,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) { @@ -1113,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); + 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}, $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; + } + 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,7 +1169,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 { @@ -1142,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,7 +1307,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 { @@ -1167,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 @@ -1223,7 +1356,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); @@ -1647,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); @@ -1678,5 +1813,8 @@ sub clean_pc92_find { } + + + 1; __END__