X-Git-Url: http://gb7djk.dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXProt.pm;h=69eb2228a194f4323638bf0b32cd6b7b005df6b1;hb=ab811a0c902225075a9bd69749f65594079433a9;hp=296553d24c16b0875d4d3f2a870bbb95d9ad9215;hpb=375f2f00086f959d332837f9035d8db1911678df;p=spider.git diff --git a/perl/DXProt.pm b/perl/DXProt.pm index 296553d2..69eb2228 100644 --- a/perl/DXProt.pm +++ b/perl/DXProt.pm @@ -40,11 +40,14 @@ use strict; use vars qw($pc11_max_age $pc23_max_age $last_pc50 $eph_restime $eph_info_restime $eph_pc34_restime $last_hour $last10 %eph %pings %rcmds $ann_to_talk $pingint $obscount %pc19list $chatdupeage $chatimportfn - $investigation_int $pc19_version $myprot_version - %nodehops $baddx $badspotter $badnode $censorpc $rspfcheck + $pc19_version $myprot_version + %nodehops $baddx $badspotter $badnode $censorpc $allowzero $decode_dk0wcy $send_opernam @checklist $eph_pc15_restime $pc92_update_period $pc92_obs_timeout %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 ); $pc11_max_age = 1*3600; # the maximum age for an incoming 'real-time' pc11 @@ -62,8 +65,7 @@ $badspotter = new DXHash "badspotter"; $badnode = new DXHash "badnode"; $last10 = $last_pc50 = time; $ann_to_talk = 1; -$rspfcheck = 1; -$eph_restime = 180; +$eph_restime = 60; $eph_info_restime = 60*60; $eph_pc15_restime = 6*60; $eph_pc34_restime = 30; @@ -71,14 +73,13 @@ $pingint = 5*60; $obscount = 2; $chatdupeage = 20 * 60; $chatimportfn = "$main::root/chat_import"; -$investigation_int = 12*60*60; # time between checks to see if we can see this node -$pc19_version = 5466; # the visible version no for outgoing PC19s generated from pc59 -$pc92_update_period = 60*60; # the period between PC92 C updates -$pc92_short_update_period = 15*60; # shorten the update period after a connection +$pc19_version = 5454; # 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 -$pc92_obs_timeout = $pc92_update_period; # the time between obscount countdowns - @checklist = @@ -163,7 +164,10 @@ $pc92_obs_timeout = $pc92_update_period; # the time between obscount countdowns undef, undef, undef, - [ qw(i c n) ], # pc90 + undef, # pc90 + undef, + [ qw(i c f l)], # pc92 + [ qw(i c f *m c *c m)], # pc93 ); # use the entry in the check list to check the field list presented @@ -180,7 +184,8 @@ sub check for ($i = 1; $i < @$ref; $i++) { my ($blank, $act) = $$ref[$i] =~ /^(b?)(\w)$/; return 0 unless $act; - next if $blank && $_[$i] =~ /^[ \*]$/; + next if $blank eq 'b' && $_[$i] =~ /^[ \*]$/; + next if $blank eq '*' && $_[$i] =~ /^\*$/; if ($act eq 'c') { return $i unless is_callsign($_[$i]); } elsif ($act eq 'i') { @@ -199,6 +204,8 @@ sub check return $i unless $_[$i] =~ /^\s*\d+-\w\w\w-[12][90]\d\d$/; } elsif ($act eq 't') { return $i unless $_[$i] =~ /^[012]\d[012345]\dZ$/; + } elsif ($act eq 'l') { + return $i unless $_[$i] =~ /^[A-Z]$/; } } return 0; @@ -207,8 +214,17 @@ sub check sub update_pc92_next { my $self = shift; - my $period = shift || $pc92_update_period; + my $period = shift || ($self->{do_pc9x} ? $pc92_update_period : $pc92_extnode_update_period); $self->{next_pc92_update} = $main::systime + $period - int rand($period / 4); + dbg("ROUTE: update_pc92_next: $self->{call} " . atime($self->{next_pc92_update})) if isdbg('obscount'); +} + +sub update_pc92_keepalive +{ + my $self = shift; + my $period = shift || $pc92_keepalive_period; + $self->{next_pc92_keepalive} = $main::systime + $period - int rand($period / 4); + dbg("ROUTE: update_pc92_keepalive: $self->{call} " . atime($self->{next_pc92_keepalive})) if isdbg('obscount'); } sub init @@ -216,7 +232,7 @@ sub init do "$main::data/hop_table.pl" if -e "$main::data/hop_table.pl"; 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; @@ -231,7 +247,8 @@ sub init $main::me->{version} = $main::version; $main::me->{build} = "$main::subversion.$main::build"; $main::me->{do_pc9x} = 1; - $main::me->update_pc92_next($pc92_update_period); + $main::me->update_pc92_next($pc92_short_update_period); + $main::me->update_pc92_keepalive; } # @@ -340,8 +357,12 @@ sub start my $script = new Script(lc $call) || new Script('node_default'); $script->run($self) if $script; - # set next_pc92_update time for this node sooner + # set up a config broadcast "quite soon" to converge tables quicker + $main::me->update_pc92_next($pc92_short_update_period); $self->update_pc92_next($pc92_short_update_period); + + # set next keepalive time + $self->update_pc92_keepalive; } # @@ -399,6 +420,12 @@ 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'; @@ -422,38 +449,6 @@ sub process my $dxchan; my $pc50s; - # send out a pc50 on EVERY channel all at once - if ($t >= $last_pc50 + $DXProt::pc50_interval) { - $pc50s = pc50($main::me, scalar DXChannel::get_all_users); - eph_dup($pc50s); - $last_pc50 = $t; - } - - foreach $dxchan (@dxchan) { - next unless $dxchan->is_node; - next if $dxchan->handle_xml; - next if $dxchan == $main::me; - - # 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) { - $dxchan->disconnect; - } else { - DXXml::Ping::add($main::me, $dxchan->call); - $dxchan->{nopings} -= 1; - $dxchan->{lastping} = $t; - $dxchan->{lastping} += $dxchan->{pingint} / 2 unless @{$dxchan->{pingtime}}; - } - } - - } - - Investigate::process(); - clean_pc92_find(); - # every ten seconds if ($t - $last10 >= 10) { # clean out ephemera @@ -461,25 +456,76 @@ sub process eph_clean(); import_chat(); - if ($main::systime >= $pc92_obs_timeout) { - time_out_pc92_routes(); - $pc92_obs_timeout = $main::systime + $pc92_update_period; + $last10 = $t; + + # send out a pc50 on EVERY channel all at once + if ($t >= $last_pc50 + $pc50_interval) { + $pc50s = pc50($main::me, scalar DXChannel::get_all_users); + eph_dup($pc50s); + $last_pc50 = $t; } - $last10 = $t; + foreach $dxchan (@dxchan) { + next unless $dxchan->is_node; + next if $dxchan == $main::me; + + # send the pc50 + $dxchan->send($pc50s) if !$dxchan->{do_pc9x} && $pc50s; + + # 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'); + } + } + } + + clean_pc92_find(); # send out config broadcasts foreach $dxchan (@dxchan) { next unless $dxchan->is_node; # send out a PC92 config record if required for me and - # all my non pc9x dependent nodes. + # all my non pc9x dependent nodes. But for dependent nodes we only do + # this if we have not seen any from anyone else for at least half + # of one update period. This should stop quite a bit of excess C + # records. Someone will win, it does not really matter who, because + # we always believe "us". if ($main::systime >= $dxchan->{next_pc92_update}) { - if ($dxchan->{call} eq $main::mycall || !$dxchan->{do_pc9x}) { - $dxchan->broadcast_pc92_update($dxchan->{call}); + if ($dxchan == $main::me || !$dxchan->{do_pc9x}) { + dbg("ROUTE: pc92 broadcast 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_extnode_update_period/2)) { + $dxchan->broadcast_pc92_update($dxchan->{call}); + } else { + $dxchan->update_pc92_next; + } + } else { + $dxchan->update_pc92_next; # this won't actually do anything, it's just to be tidy } } } + + # 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) { + my ($add, $del) = gen_pc92_changes(); + $main::me->route_pc92d($main::mycall, undef, $main::routeroot, @$del) if @$del; + $main::me->route_pc92a($main::mycall, undef, $main::routeroot, @$add) if @$add; + clear_pc92_changes(); + } } if ($main::systime - 3600 > $last_hour) { @@ -508,6 +554,7 @@ sub send_dx_spot 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}); } } @@ -654,7 +701,8 @@ sub send_announce } } - if (AnnTalk::dup($from, $target, $_[2])) { + # the sysop ('*') thing is an attempt to minimise the damage caused by non-updated PC93 generators + if (AnnTalk::dup($from, $target, $_[2]) || ($_[3] eq '*' && AnnTalk::dup($from, 'ALL', $_[2]))) { my $dxchan = DXChannel::get($from); if ($self == $main::me && $dxchan && $dxchan->is_user) { if ($dxchan->priv < 5) { @@ -778,7 +826,21 @@ sub announce sub chat { - goto &announce; + my $self = shift; + my $line = shift; + my $isolate = shift; + my $to = shift; + my $target = shift; + my $text = shift; + my ($filter, $hops); + + if ($self->{annfilter}) { + ($filter, $hops) = $self->{annfilter}->it(@_); + return unless $filter; + } + if (($self->is_spider || $self->is_ak1a) && $_[1] ne $main::mycall) { + send_prot_line($self, $filter, $hops, $isolate, $line); + } } @@ -801,8 +863,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 @@ -818,13 +882,13 @@ sub send_local_config my $node; my @rawintcalls = map { $_->nodes } @localnodes if @localnodes; my @intcalls; - for $node (@rawintcalls) { - push @intcalls, $node unless grep $node eq $_, @intcalls; + foreach $node (@rawintcalls) { + push @intcalls, $node if grep $_ && $node != $_, @intcalls; } my $ref = Route::Node::get($self->{call}); my @rnodes = $ref->nodes; - for $node (@intcalls) { - push @remotenodes, Route::Node::get($node) unless grep $node eq $_, @rnodes, @remotenodes; + foreach $node (@intcalls) { + push @remotenodes, Route::Node::get($node) if grep $_ && $node != $_, @rnodes, @remotenodes; } $self->send_route($main::mycall, \&pc19, scalar(@remotenodes), @remotenodes); } @@ -847,11 +911,12 @@ sub gen_my_pc92_config my $node = shift; if ($node->{call} eq $main::mycall) { + 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; dbg("ROUTE: localnodes: " . join(',', map{$_->{call}} @localnodes)) if isdbg('routelow'); - return pc92c($main::routeroot, @localnodes); + return pc92c($node, @localnodes); } else { my @rout = map {my $r = Route::User::get($_); $r ? ($r) : ()} $node->users; return pc92c($node, @rout); @@ -885,12 +950,35 @@ sub broadcast_pc92_update my $self = shift; my $call = shift; - dbg('DXProt::broadcast_pc92_update') if isdbg('trace'); + dbg("ROUTE: broadcast_pc92_update $call") if isdbg('obscount'); my $nref = Route::Node::get($call); + unless ($nref) { + dbg("ERROR: broadcast_pc92_update - Route::Node $call disappeared"); + return; + } my $l = $nref->last_PC92C(gen_my_pc92_config($nref)); + $nref->lastid(last_pc9x_id()); $main::me->broadcast_route_pc9x($main::mycall, undef, $l, 0); - $self->update_pc92_next($pc92_update_period); + $self->update_pc92_next; +} + +sub broadcast_pc92_keepalive +{ + my $self = shift; + my $call = shift; + + dbg("ROUTE: broadcast_pc92_keepalive $call") if isdbg('obscount'); + + my $nref = Route::Node::get($call); + unless ($nref) { + dbg("ERROR: broadcast_pc92_keepalive - Route::Node $call disappeared"); + return; + } + my $l = pc92k($nref); + $nref->lastid(last_pc9x_id()); + $main::me->broadcast_route_pc9x($main::mycall, undef, $l, 0); + $self->update_pc92_keepalive; } sub time_out_pc92_routes @@ -901,14 +989,14 @@ sub time_out_pc92_routes my $o = $n->dec_obs; if ($o <= 0) { if (my $dxchan = DXChannel::get($n->call)) { - dbg("disconnecting local pc92 $dxchan->{call} on obscount") if isdbg('obscount'); + dbg("ROUTE: disconnecting local pc92 $dxchan->{call} on obscount") if isdbg('obscount'); $dxchan->disconnect; next; } my @parents = map {Route::Node::get($_)} $n->parents; for (@parents) { if ($_) { - dbg("deleting pc92 $_->{call} from $n->{call} on obscount") if isdbg('obscount'); + dbg("ROUTE: deleting pc92 $_->{call} from $n->{call} on obscount") if isdbg('obscount'); push @rdel, $n->del($_); } } @@ -999,7 +1087,7 @@ sub adjust_hops my $call = $self->{call}; my $hops; - if (($hops) = $s =~ /\^H(\d+)\^?~?$/o) { + if (($hops) = $s =~ /\^H([-\d]+)\^?~?$/o) { my ($pcno) = $s =~ /^PC(\d\d)/o; confess "$call called adjust_hops with '$s'" unless $pcno; my $ref = $nodehops{$call} if %nodehops; @@ -1008,8 +1096,11 @@ sub adjust_hops return "" if defined $newhops && $newhops == 0; $newhops = $ref->{default} unless $newhops; return "" if defined $newhops && $newhops == 0; - $newhops = $hops if !$newhops; - $s =~ s/\^H(\d+)(\^~?)$/\^H$newhops$2/ if $newhops; + $newhops = $hops unless $newhops; + return "" unless $newhops > 0; + $s =~ s/\^H(\d+)(\^~?)$/\^H$newhops$2/ if $newhops != $hops; + } else { + return "" unless $hops > 0; } } return $s; @@ -1031,10 +1122,10 @@ 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); 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! + 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! 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}; @@ -1050,7 +1141,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 { @@ -1075,7 +1166,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 { @@ -1125,12 +1216,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"))); } @@ -1139,16 +1230,6 @@ sub disconnect # do routing stuff, remove me from routing table my $node = Route::Node::get($call); - my @rout; - if ($node) { - @rout = $node->del($main::routeroot); - - # and all my ephemera as well - for (@rout) { - my $c = $_->call; - eph_del_regex("^PC1[679].*$c"); - } - } RouteDB::delete_interface($call); @@ -1156,12 +1237,6 @@ sub disconnect my $mref = DXMsg::get_busy($call); $mref->stop_msg($call) if $mref; - # broadcast to all other nodes that all the nodes connected to via me are gone - unless ($pc39flag && $pc39flag == 2) { - $self->route_pc21($main::mycall, undef, @rout) if @rout; - $self->route_pc92d($main::mycall, undef, $main::routeroot, $node) if $node; - } - # remove outstanding pings delete $pings{$call}; @@ -1174,6 +1249,43 @@ sub disconnect Log('DXProt', $call . " Disconnected"); $self->SUPER::disconnect; + + # here we determine what needs to go out of the routing table + my @rout; + if ($node && $pc39flag != 2) { + dbg('%Route::Node::List = ' . join(',', sort keys %Route::Node::list)) if isdbg('routedisc'); + + @rout = $node->del($main::routeroot); + + dbg('@rout = ' . join(',', sort map {$_->call} @rout)) if isdbg('routedisc'); + + # now we need to see what can't be routed anymore and came + # in via this node (probably). + my $n = 0; + while ($n != @rout) { + $n = @rout; + for (Route::Node::get_all()) { + unless ($_->dxchan) { + push @rout, $_->delete; + } + } + dbg('@rout = ' . join(',', sort map {$_->call} @rout)) if isdbg('routedisc'); + } + + dbg('%Route::Node::List = ' . join(',', sort keys %Route::Node::list)) if isdbg('routedisc'); + + # and all my ephemera as well + for (@rout) { + my $c = $_->call; + eph_del_regex("^PC1[679].*$c"); + } + } + + # broadcast to all other nodes that all the nodes connected to via me are gone + unless ($pc39flag == 2) { + $self->route_pc21($main::mycall, undef, @rout) if @rout; + $self->route_pc92d($main::mycall, undef, $main::routeroot, $node) if $node; + } } @@ -1208,6 +1320,12 @@ sub send_route for (; @_ && $no; $no--) { my $r = shift; + # don't send messages with $self's call in back to them + if ($r->call eq $self->{call}) { + dbg("PCPROT: trying to send $self->{call} back itself") if isdbg('chanerr'); + next; + } + if (!$self->{isolate} && $self->{routefilter}) { $filter = undef; if ($r) { @@ -1284,8 +1402,9 @@ sub broadcast_route_nopc9x next if $origin eq $dxchan->{call}; # don't route some from this call back again. next unless $dxchan->isa('DXProt'); next if $dxchan->{do_pc9x}; - next if ($generate == \&pc16 || $generate==\&pc17) && !$dxchan->user->wantsendpc16; - + if ($generate == \&pc16 || $generate==\&pc17) { + next unless $dxchan->user->wantsendpc16; + } $dxchan->send_route($origin, $generate, @_); } } @@ -1385,11 +1504,13 @@ sub route_pc41 broadcast_route($self, $origin, \&pc41, $line, 1, @_); } +# this is probably obsolete now sub route_pc50 { my $self = shift; my $origin = shift; my $line = shift; + broadcast_route($self, $origin, \&pc50, $line, 1, @_); } @@ -1528,18 +1649,15 @@ sub import_chat foreach my $text (@msg) { next unless $text && $text !~ /^\s*#/; - if ($target eq 'ALL' || $target eq 'LOCAL' || $target eq 'SYSOP') { - my $sysopflag = $target eq 'SYSOP' ? '*' : ' '; - if ($target ne 'LOCAL') { - send_announce($main::me, pc12($main::mycall, $text, '*', $sysopflag), $main::mycall, '*', $text, $sysopflag, $main::mycall, '0'); - } else { - Log('ann', 'LOCAL', $main::mycall, $text); - DXChannel::broadcast_list("To LOCAL de ${main::mycall}: $text\a", 'ann', undef, DXCommandmode->get_all()); - } + if ($target eq 'ALL' || $target eq 'LOCAL' || $target eq 'SYSOP' || $target eq 'WX') { + my $sysop = uc $target eq 'SYSOP' ? '*' : ' '; + my $wx = uc $target eq 'WX' ? '1' : '0'; + my $via = $target; + $via = '*' if $target eq 'ALL' || $target eq 'SYSOP'; + Log('ann', $target, $main::mycall, $text); + $main::me->normal(DXProt::pc93($target, $main::mycall, $via, $text)); } else { - my $msgid = nextchatmsgid(); - $text = "#$msgid $text"; - send_chat($main::me, pc12($main::mycall, $text, '*', $target), $main::mycall, '*', $text, $target, $main::mycall, '0'); + DXCommandmode::send_chats($main::me, $target, $text); } } }