From c1e8434f73e0b575c3b2d28cd3c257c3b15ffbe6 Mon Sep 17 00:00:00 2001 From: minima Date: Thu, 8 Jul 2004 00:30:07 +0000 Subject: [PATCH] got investigate and auto believe essentially working --- perl/DXProt.pm | 41 ++++++++++++++++---- perl/DXUser.pm | 2 +- perl/Investigate.pm | 93 +++++++++++++++++++++++++++++++++++++++++++-- 3 files changed, 125 insertions(+), 11 deletions(-) diff --git a/perl/DXProt.pm b/perl/DXProt.pm index 9df3b3d1..dae885e4 100644 --- a/perl/DXProt.pm +++ b/perl/DXProt.pm @@ -710,6 +710,9 @@ sub handle_16 # do we believe this call? 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; } @@ -790,6 +793,9 @@ sub handle_17 # do we believe this call? 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; } @@ -928,10 +934,11 @@ sub handle_19 # 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)) { - my $iref = Investigate->new($call); - $iref->version($ver); - $iref->here($here); + 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; @@ -985,6 +992,9 @@ 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; } @@ -1413,12 +1423,18 @@ sub handle_51 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; + } } } } @@ -1692,6 +1708,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; @@ -1725,6 +1743,8 @@ sub process } } + Investigate::process(); + # every ten seconds if ($t - $last10 >= 10) { # clean out ephemera @@ -2165,16 +2185,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); - $u->lastping($main::systime) if $u; + if ($u) { + $u->lastping($main::systime); + $u->put; + } } sub process_rcmd diff --git a/perl/DXUser.pm b/perl/DXUser.pm index 9e3ef433..123dce61 100644 --- a/perl/DXUser.pm +++ b/perl/DXUser.pm @@ -785,7 +785,7 @@ sub set_believe my $self = shift; my $call = uc shift; $self->{believe} ||= []; - push @{$self->{believe}}, $call; + push @{$self->{believe}}, $call unless grep $_ eq $call, @{$self->{believe}}; } sub unset_believe diff --git a/perl/Investigate.pm b/perl/Investigate.pm index 8db4c355..3126f685 100644 --- a/perl/Investigate.pm +++ b/perl/Investigate.pm @@ -27,8 +27,12 @@ $BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/ || (0,0)) $main::build += $VERSION; $main::branch += $BRANCH; -use vars qw (%list %valid); +use vars qw (%list %valid $pingint $maxpingwait); +$pingint = 5; # interval between pings for each investigation + # this is to stop floods of pings +$maxpingwait = 120; # the maximum time we will wait for a reply to a ping +my $lastping = 0; # last ping done %list = (); # the list of outstanding investigations %valid = ( # valid fields call => '0,Callsign', @@ -37,6 +41,10 @@ use vars qw (%list %valid); build => '0,Node Build', here => '0,Here?,yesno', conf => '0,In Conf?,yesno', + pingsent => '0,Time ping sent,atime', + state => '0,State', + via => '0,Via Node', + pcxx => '0,Stored PCProt,parray', ); @@ -44,15 +52,94 @@ sub new { my $pkg = shift; my $call = shift; - my $self = $list{$call} || bless { call=>$call, start=>$main::systime }, ref($pkg) || $pkg; + my $via = shift; + + my $self = $list{"$via,$call"}; + unless ($self) { + $self = bless { + call=>$call, + via=>$via, + start=>$main::systime, + state=>'start', + pcxx=>[], + }, ref($pkg) || $pkg; + $list{"$via,$call"} = $self; + } + dbg("Investigate: New $call via $via") if isdbg('investigate'); return $self; } sub get { - return $list{$_[0]}; + return $list{"$_[1],$_[0]"}; } +sub chgstate +{ + my $self = shift; + my $state = shift; + dbg("Investigate: $self->{call} via $self->{via} state $self->{state}->$state") if isdbg('investigate'); + $self->{state} = $state; +} + +sub handle_ping +{ + my $self = shift; + dbg("Investigate: ping received for $self->{call} via $self->{via}") if isdbg('investigate'); + if ($self->{state} eq 'waitping') { + delete $list{"$self->{via},$self->{call}"}; + my $user = DXUser->get_current($self->{via}); + if ($user) { + $user->set_believe($self->{call}); + $user->put; + } + my $dxchan = DXChannel->get($self->{via}); + if ($dxchan) { + dbg("Investigate: sending PC19 for $self->{call}") if isdbg('investigate'); + foreach my $pc (@{$self->{pcxx}}) { + no strict 'refs'; + my $handle = "handle_$pc->[0]"; + dbg("Investigate: sending PC$pc->[0] (" . join(',', @$pc) . ")") if isdbg('investigate'); + $pc->[1] =~ s/\^/\\\^/g; + DXProt::eph_del_regex($pc->[1]); + $dxchan->$handle(@$pc); + } + } + } +} + +sub store_pcxx +{ + my $self = shift; + dbg("Investigate: Storing (". join(',', @_) . ")") if isdbg('investigate'); + push @{$self->{pcxx}}, [@_]; +} + +sub process +{ + while (my ($k, $v) = each %list) { + if ($v->{state} eq 'start') { + if ($main::systime > $lastping+$pingint) { + DXProt::addping($main::mycall, $v->{call}, $v->{via}); + $v->{start} = $lastping = $main::systime; + dbg("Investigate: ping sent to $v->{call} via $v->{via}") if isdbg('investigate'); + $v->chgstate('waitping'); + } + } elsif ($v->{state} eq 'waitping') { + if ($main::systime > $v->{start} + $maxpingwait) { + dbg("Investigate: ping timed out on $v->{call} via $v->{via}") if isdbg('investigate'); + delete $list{$k}; + my $user = DXUser->get_current($v->{via}); + if ($user) { + $user->lastping($main::systime); + $user->put; + } + } + } + } +} + + sub AUTOLOAD { no strict; -- 2.34.1