X-Git-Url: http://dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXProt.pm;h=8347dd0e35617964f906ae6f864aad18f9a9902a;hb=eb631a639a657f071f4711f6f4f5c585ab6364c6;hp=e272216556579d557f32a3b06c7ecdc8d95ef2d4;hpb=05a7fdd4a58c51e21b55b0509b054b625839290c;p=spider.git diff --git a/perl/DXProt.pm b/perl/DXProt.pm index e2722165..8347dd0e 100644 --- a/perl/DXProt.pm +++ b/perl/DXProt.pm @@ -33,6 +33,7 @@ use DXHash; use Route; use Route::Node; use Script; +use Investigate; use strict; @@ -43,8 +44,8 @@ $main::build += $VERSION; $main::branch += $BRANCH; 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 + $last_hour $last10 %eph %pings %rcmds $ann_to_talk $pc19_version + $pingint $obscount %pc19list $chatdupeage $investigation_int %nodehops $baddx $badspotter $badnode $censorpc $rspfcheck $allowzero $decode_dk0wcy $send_opernam @checklist); @@ -71,6 +72,9 @@ $eph_pc34_restime = 30; $pingint = 5*60; $obscount = 2; $chatdupeage = 20 * 60 * 60; +$investigation_int = 7*86400; # time between checks to see if we can see this node +$pc19_version = 5466; # the visible version no for outgoing PC19s generated from pc59 + @checklist = ( @@ -199,6 +203,19 @@ sub init { do "$main::data/hop_table.pl" if -e "$main::data/hop_table.pl"; confess $@ if $@; + + my $user = DXUser->get($main::mycall); + $DXProt::myprot_version += $main::version*100; + $main::me = DXProt->SUPER::alloc($main::mycall, 0, $user); + $main::me->{here} = 1; + $main::me->{state} = "indifferent"; + $main::me->{sort} = 'S'; # S for spider + $main::me->{priv} = 9; + $main::me->{metric} = 0; + $main::me->{pingave} = 0; + $main::me->{registered} = 1; + $main::me->{version} = $main::version; + $main::me->{build} = $main::build; } # @@ -212,8 +229,12 @@ sub new # add this node to the table, the values get filled in later my $pkg = shift; my $call = shift; - $main::routeroot->add($call, '5000', Route::here(1)) if $call ne $main::mycall; + my $uref = Route::Node::get($call) || Route::Node->new($call); + $uref->here(1); + $uref->conf(0); + $uref->version($pc19_version); + $main::routeroot->link_node($uref, $self); return $self; } @@ -427,7 +448,7 @@ sub handle_10 if ($ref = Route::get($to)) { $vref = Route::Node::get($via) if $via; $vref = undef unless $vref && grep $to eq $_, $vref->users; - $ref->dxchan->talk($from, $to, $vref ? $via : undef, $_[3], $_[6]); + $ref->bestdxchan->talk($from, $to, $vref ? $via : undef, $_[3], $_[6]); return; } @@ -436,7 +457,7 @@ sub handle_10 $ref = Route::get($from); $vref = $ref = Route::Node::get($_[6]) unless $ref; if ($ref) { - $dxchan = $ref->dxchan; + $dxchan = $ref->bestdxchan; $dxchan->talk($main::mycall, $from, $vref ? $vref->call : undef, $dxchan->msg('talknh', $to) ); } } @@ -555,7 +576,7 @@ sub handle_11 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; + my $dxchan = $node->bestdxchan; if ($dxchan && $dxchan->is_clx) { route(undef, $to, pc84($main::mycall, $to, $main::mycall, $cmd)); } else { @@ -565,7 +586,7 @@ sub handle_11 $to = $_[7]; $node = Route::Node::get($to); if ($node) { - $dxchan = $node->dxchan; + $dxchan = $node->bestdxchan; if ($dxchan && $dxchan->is_clx) { route(undef, $to, pc84($main::mycall, $to, $main::mycall, $cmd)); } else { @@ -649,7 +670,7 @@ sub handle_12 if ($call) { my $ref = Route::get($call); if ($ref) { - $dxchan = $ref->dxchan; + $dxchan = $ref->bestdxchan; $dxchan->talk($_[1], $call, undef, $_[3], $_[5]) if $dxchan != $self; return; } @@ -690,7 +711,13 @@ sub handle_16 } # do we believe this call? - next unless $ncall eq $self->{call} || $self->is_believed($ncall); + unless ($ncall eq $self->{call} || $self->is_believed($ncall)) { + if (my $ivp = Investigate::get($ncall, $self->{call})) { + $ivp->store_pcxx($pcno,$line,$origin,@_); + } + dbg("PCPROT: We don't believe $ncall on $self->{call}"); + return; + } my $node = Route::Node::get($ncall); unless ($node) { @@ -723,8 +750,8 @@ sub handle_16 dbg("PCPROT: $call is a node") if isdbg('chanerr'); next; } - - $r = Route::User::get($call) || Route::User::get($call); + + $r = Route::User::get($call) || Route::User->new($call); $r->here($here); $r->conf($conf); $node->lastseen($main::systime); @@ -767,7 +794,13 @@ sub handle_17 } # do we believe this call? - next unless $ncall eq $self->{call} || $self->is_believed($ncall); + unless ($ncall eq $self->{call} || $self->is_believed($ncall)) { + if (my $ivp = Investigate::get($ncall, $self->{call})) { + $ivp->store_pcxx($pcno,$line,$origin,@_); + } + dbg("PCPROT: We don't believe $ncall on $self->{call}"); + return; + } my $uref = Route::User::get($ucall); unless ($uref) { @@ -825,9 +858,20 @@ sub handle_18 $self->newroute( $_[1] =~ /NewRoute/ ); # first clear out any nodes on this dxchannel - my $parent = Route::Node::get($self->{call}); - my @rout = $parent->del_nodes; - $self->route_pc21($origin, $line, @rout, $parent) if @rout; + my $node = Route::Node::get($self->{call}) ; + my @rout; + foreach my $n ($node->nodes) { + next if $n eq $main::mycall; + next if $n eq $self->{call}; + my $nref = Route::Node::get($n); + push @rout, $node->remove_route($nref, $self) if $nref; + } + $self->route_pc21($origin, $line, @rout) if @rout; + for (@rout) { + $_->delete; + }; + + # send the new config $self->send_local_config(); $self->send(pc20()); } @@ -875,11 +919,6 @@ sub handle_19 next if length $call < 3; # min 3 letter callsigns next if $call eq $main::mycall; - # do we believe this call? - next unless $call eq $self->{call} || $self->is_believed($call); - - eph_del_regex("^PC(?:21\\^$call|17\\^[^\\^]+\\^$call)"); - # add this station to the user database, if required (don't remove SSID from nodes) my $user = DXUser->get_current($call); if (!$user) { @@ -891,7 +930,24 @@ sub handle_19 $user->node($call); } $user->wantroutepc19(1) unless defined $user->wantroutepc19; + $user->lastin($main::systime) unless DXChannel->get($call); + $user->put; + + # do we believe this call? + unless ($call eq $self->{call} || $self->is_believed($call)) { + my $pt = $user->lastping || 0; + if ($pt+$investigation_int < $main::systime && !Investigate::get($call, $self->{call})) { + my $ivp = Investigate->new($call, $self->{call}); + $ivp->version($ver); + $ivp->here($here); + $ivp->store_pcxx($pcno,$line,$origin,'PC19',$here,$call,$conf,$ver,$_[-1]); + } + dbg("PCPROT: We don't believe $call on $self->{call}"); + next; + } + eph_del_regex("^PC(?:21\\^$call|17\\^[^\\^]+\\^$call)"); + my $r = Route::Node::get($call) || Route::Node->new($call); $r->here($here); $r->conf($conf); @@ -906,14 +962,11 @@ sub handle_19 # unbusy and stop and outgoing mail (ie if somehow we receive another PC19 without a disconnect) my $mref = DXMsg::get_busy($call); $mref->stop_msg($call) if $mref; - - $user->lastin($main::systime) unless DXChannel->get($call); - $user->put; } # route out new nodes to legacy nodes $self->route_pc19($origin, $line, @new) if @new; - $self->route_pc59('A', 0, $self->{call}, @rout) if @rout; + $self->route_pc59('A', hexstamp(), $self->{call}, @rout) if @rout; } # send local configuration @@ -940,6 +993,14 @@ sub handle_21 return if $call eq $main::mycall; # don't allow malicious buggers to disconnect me (or ignore loops)! + unless ($call eq $self->{call} || $self->is_believed($call)) { + if (my $ivp = Investigate::get($call, $self->{call})) { + $ivp->store_pcxx($pcno,$line,$origin,@_); + } + dbg("PCPROT: We don't believe $call on $self->{call}"); + return; + } + eph_del_regex("^PC1[679].*$call"); # if I get a PC21 from the same callsign as self then treat it @@ -966,11 +1027,11 @@ sub handle_21 # input filter it return unless $self->in_filter_route($node); push @rout, $node; - push @new, $node->link_node($parent, $self); + push @new, $parent->remove_route($node, $self); } $self->route_pc21($origin, $line, @new) if @new; - $self->route_pc59('D', 0, $self->{call}, @rout) if @rout; + $self->route_pc59('D', hexstamp(), $self->{call}, @rout) if @rout; # get rid of orphaned nodes; $_->delete for @new; @@ -1361,7 +1422,21 @@ sub handle_51 } else { $tochan->{pingave} = $tochan->{pingave} + (($t - $tochan->{pingave}) / 6); } + my $rref = Route::Node::get($tochan->{call}); + $rref->pingtime($tochan->{pingave}) if $rref; $tochan->{nopings} = $nopings; # pump up the timer + if (my $ivp = Investigate::get($from, $self->{call})) { + $ivp->handle_ping; + } + } elsif (my $rref = Route::Node::get($r->{call})) { + if (defined $rref->pingtime) { + $rref->pingtime($rref->pingtime + (($t - $rref->pingtime) / 6)); + } else { + $rref->pingtime($t); + } + if (my $ivp = Investigate::get($from, $self->{call})) { + $ivp->handle_ping; + } } } } @@ -1385,30 +1460,35 @@ sub handle_59 my $line = shift; my $origin = shift; - return unless eph_dup($line); - my ($sort, $hextime, $ncall) = @_[1,2,3]; if ($ncall eq $main::mycall) { dbg("PCPROT: ignoring PC59 for me") if isdbg('chan'); return; } - # mark myself as NewRoute if I get a PC59 - $self->{newroute} = 1 if $ncall eq $self->{call}; - # do this once for filtering with a throwaway routing entry if a new node my $fnode = Route::Node::get($ncall) || Route::new($ncall); return unless $self->in_filter_route($fnode); + return if eph_dup($line); + + # mark myself as NewRoute if I get a PC59 + $self->{newroute} = 1 if $ncall eq $self->{call}; + # now do it properly for actions - my $node = Route::Node::get($ncall) || Route::Node::new($ncall); + my $node = Route::Node::get($ncall) || Route::Node->new($ncall); + $node->newroute(1); # find each of the entries (or create new ones) my @refs; - for my $ent (@_[4..-1]) { + for my $ent (@_[4..$#_]) { + next if $ent =~ /^H\d+$/; + my ($esort, $ehere, $ecall) = unpack "A A A*", $ent; my $ref; + next unless $esort && defined $ehere && $ecall; + # create user, if required my $user = DXUser->get_current($ecall); unless ($user) { @@ -1431,7 +1511,7 @@ sub handle_59 $user->node($ncall); $user->put; } - $ref = Route::User::new($ecall, 0); + $ref = Route::User->new($ecall, 0); } } elsif ($esort eq 'N') { $ref = Route::Node::get($ecall); @@ -1447,14 +1527,14 @@ sub handle_59 $user->node($ncall); $user->put; } - $ref = Route::Node::new($ecall, 0); + $ref = Route::Node->new($ecall, 0); } } else { dbg("DXPROT: unknown entity type '$esort' on $ecall for node $ncall") if isdbg('chan'); next; } $ref->here($ehere); # might as well set this here - $ref->lastheard($main::systime); + $ref->lastseen($main::systime); push @refs, $ref; } @@ -1465,6 +1545,7 @@ sub handle_59 if ($sort eq 'D') { for my $ref (@refs) { next if $ref->call eq $ncall; + next if $ref->call eq $main::mycall; if ($ref->isa('Route::Node')) { push @delnode, $node->unlink_node($ref, $self); } elsif ($ref->isa('Route::User')) { @@ -1479,11 +1560,12 @@ sub handle_59 if ($sort eq 'A') { for my $ref (@refs) { next if $ref->call eq $ncall; + next if $ref->call eq $main::mycall; if ($ref->isa('Route::Node')) { my $new = $node->link_node($ref, $self); push @addnode, $new if $new; } elsif ($ref->isa('Route::User')) { - push @adduser, $node->del_user($ref); + push @adduser, $node->add_user($ref); } } } @@ -1499,6 +1581,8 @@ sub handle_59 my @au; for my $r (map {Route::Node::get($_)} $node->nodes) { next unless $r; + next if $r->call eq $ncall; + next if $r->call eq $main::mycall; push @dn, $r unless grep $_->call eq $r->call, @refs; } for my $r (map {Route::User::get($_)} $node->users) { @@ -1507,23 +1591,25 @@ sub handle_59 } for my $r (@refs) { next unless $r; + next if $r->call eq $ncall; + next if $r->call eq $main::mycall; if ($r->isa('Route::Node')) { push @an, $r unless grep $r->call eq $_, $node->nodes; } elsif ($r->isa('Route::User')) { push @au, $r unless grep $r->call eq $_, $node->users; } } + push @addnode, $node if $self->{state} =~ /^init/; push @delnode, $node->unlink_node($_, $self) for @dn; push @deluser, $node->del_user($_) for @du; push @addnode, $node->link_node($_, $self) for @an; push @adduser, $node->add_user($_) for @au; } - $self->route_pc21($origin, $line, @delnode) if @delnode; $self->route_pc19($origin, $line, @addnode) if @addnode; - $self->route_pc17($origin, $line, @deluser) if @deluser; - $self->route_pc16($origin, $line, @adduser) if @adduser; + $self->route_pc17($origin, $line, $node, @deluser) if @deluser; + $self->route_pc16($origin, $line, $node, @adduser) if @adduser; $self->route_pc59($sort, $hextime, $ncall, @refs) if @refs; $_->delete for @delnode, @deluser; @@ -1625,6 +1711,8 @@ sub handle_default # This is called from inside the main cluster processing loop and is used # for despatching commands that are doing some long processing job # +# It is called once per second +# sub process { my $t = time; @@ -1658,6 +1746,8 @@ sub process } } + Investigate::process(); + # every ten seconds if ($t - $last10 >= 10) { # clean out ephemera @@ -1957,7 +2047,9 @@ sub send_local_config if ($self->{newroute}) { my @nodes = $self->{isolate} ? ($main::routeroot) : grep { $_->call ne $main::mycall && $_ != $self && !$_->{isolate} } DXChannel::get_all_nodes(); my @users = DXChannel::get_all_users(); - $self->send_route($main::mycall, \&pc59c, @nodes+@users+1, (grep { Route::get($_) } $main::routeroot, @nodes, @users)); + @localnodes = map { Route::Node::get($_->{call}) } @nodes; + my @localusers = map { Route::User::get($_->{call}) } @users; + $self->send_route($main::mycall, \&pc59, @nodes+@users+4, 'C', 0, $main::mycall, $main::routeroot, @localnodes, @localusers); } else { # send our nodes if ($self->{isolate}) { @@ -2017,7 +2109,7 @@ sub route my $dxchan = DXChannel->get($call); unless ($dxchan) { my $cl = Route::get($call); - $dxchan = $cl->dxchan if $cl; + $dxchan = $cl->bestdxchan if $cl; if (ref $dxchan) { if (ref $self && $dxchan eq $self) { dbg("PCPROT: Trying to route back to source, dropped") if isdbg('chanerr'); @@ -2096,14 +2188,23 @@ sub load_hops # add a ping request to the ping queues sub addping { - my ($from, $to) = @_; + my ($from, $to, $via) = @_; my $ref = $pings{$to} || []; my $r = {}; $r->{call} = $from; $r->{t} = [ gettimeofday ]; - route(undef, $to, pc51($to, $main::mycall, 1)); + if ($via && (my $dxchan = DXChannel->get($via))) { + $dxchan->send(pc51($to, $main::mycall, 1)); + } else { + route(undef, $to, pc51($to, $main::mycall, 1)); + } push @$ref, $r; $pings{$to} = $ref; + my $u = DXUser->get_current($to); + if ($u) { + $u->lastping($main::systime); + $u->put; + } } sub process_rcmd @@ -2193,7 +2294,7 @@ sub addrcmd $rcmds{$to} = $r; my $ref = Route::Node::get($to); - my $dxchan = $ref->dxchan; + my $dxchan = $ref->bestdxchan; if ($dxchan && $dxchan->is_clx) { route(undef, $to, pc84($main::mycall, $to, $self->{call}, $cmd)); } else { @@ -2220,28 +2321,18 @@ sub disconnect my $node = Route::Node::get($call); my @rout; if ($node) { - @rout = $node->del($main::routeroot); - - # and all my ephemera as well + + # remove the route from this node and return a list + # of nodes that have become orphanned as a result. + push @rout, $main::routeroot->remove_route($node, $self); + + # remove all my ephemera as well for (@rout) { my $c = $_->call; eph_del_regex("^PC1[679].*$c"); } } - # remove them from the pc19list as well - while (my ($k,$v) = each %pc19list) { - my @l = grep {$_->[0] ne $call} @{$pc19list{$k}}; - if (@l) { - $pc19list{$k} = \@l; - } else { - delete $pc19list{$k}; - } - - # and the ephemera - eph_del_regex("^PC1[679].*$k"); - } - # unbusy and stop and outgoing mail my $mref = DXMsg::get_busy($call); $mref->stop_msg($call) if $mref; @@ -2249,8 +2340,12 @@ sub disconnect # 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_pc59('D', hexstamp(), $main::mycall, $node); } + # delete all the unwanted nodes + $_->delete for @rout; + # remove outstanding pings delete $pings{$call}; @@ -2297,7 +2392,6 @@ sub send_route # deal with non routing parameters unless (ref $r && $r->isa('Route')) { push @rin, $r; - $no++; next; } @@ -2347,8 +2441,12 @@ sub broadcast_route next if $dxchan == $main::me; next unless $dxchan->isa('DXProt'); next if ($generate == \&pc16 || $generate==\&pc17) && !$dxchan->user->wantsendpc16; - next if ($generate == \&pc19 || $generate==\&pc21) && !$dxchan->user->wantsendpc19; - next if ($generate == \&pc59) && !$dxchan->{newroute}; + if ($dxchan->{newroute}) { + next if ($generate == \&pc19 || $generate==\&pc21); + } else { + next if ($generate == \&pc19 || $generate==\&pc21) && !$dxchan->user->wantroutepc19; + next if ($generate == \&pc59); + } $dxchan->send_route($origin, $generate, @_); } @@ -2419,8 +2517,7 @@ sub route_pc59 my $origin = shift; my $line = shift; - # @_ - 2 because we start with [ACD], hexstamp - broadcast_route($self, $origin, \&pc59, $line, scalar @_ - 2, @_); + broadcast_route($self, $origin, \&pc59, $line, scalar @_, @_); } sub in_filter_route