From 07f2e6cff3523ababee9c42008568cb469befe9d Mon Sep 17 00:00:00 2001 From: minima Date: Wed, 7 Jul 2004 18:09:09 +0000 Subject: [PATCH] basically working OK Now adding remote node investigation --- perl/DXProt.pm | 41 ++++++++++++++++++-------- perl/DXUser.pm | 1 + perl/Investigate.pm | 70 +++++++++++++++++++++++++++++++++++++++++++++ perl/Route/Node.pm | 1 + 4 files changed, 101 insertions(+), 12 deletions(-) create mode 100644 perl/Investigate.pm diff --git a/perl/DXProt.pm b/perl/DXProt.pm index ba958cfa..9df3b3d1 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; @@ -44,7 +45,7 @@ $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 + $pingint $obscount %pc19list $chatdupeage $investigation_int %nodehops $baddx $badspotter $badnode $censorpc $rspfcheck $allowzero $decode_dk0wcy $send_opernam @checklist); @@ -71,6 +72,7 @@ $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 @checklist = ( @@ -909,14 +911,6 @@ sub handle_19 next if length $call < 3; # min 3 letter callsigns next if $call eq $main::mycall; - # do we believe this call? - unless ($call eq $self->{call} || $self->is_believed($call)) { - dbg("PCPROT: We don't believe $call on $self->{call}"); - next; - } - - 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) { @@ -928,7 +922,23 @@ 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)) { + my $iref = Investigate->new($call); + $iref->version($ver); + $iref->here($here); + } + 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); @@ -943,9 +953,6 @@ 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 @@ -1403,7 +1410,15 @@ 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 + } elsif (my $rref = Route::Node::get($r->{call})) { + if (defined $rref->pingtime) { + $rref->pingtime($rref->pingtime + (($t - $rref->pingtime) / 6)); + } else { + $rref->pingtime($t); + } } } } @@ -2158,6 +2173,8 @@ sub addping 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; } sub process_rcmd diff --git a/perl/DXUser.pm b/perl/DXUser.pm index 22cf0df2..9e3ef433 100644 --- a/perl/DXUser.pm +++ b/perl/DXUser.pm @@ -93,6 +93,7 @@ $v3 = 0; version => '1,Version', build => '1,Build', believe => '1,Believable nodes,parray', + lastping => '1,Last Ping at,atime', ); #no strict; diff --git a/perl/Investigate.pm b/perl/Investigate.pm new file mode 100644 index 00000000..8db4c355 --- /dev/null +++ b/perl/Investigate.pm @@ -0,0 +1,70 @@ +# +# Investigate whether an external node is accessible +# +# If it is, make it believable otherwise mark as not +# to be believed. +# +# It is possible to store up state for a node to be +# investigated, so that if it is accessible, its details +# will be passed on to whomsoever might be interested. +# +# Copyright (c) 2004 Dirk Koopman, G1TLH +# +# $Id$ +# + +use strict; + +package Investigate; + +use DXDebug; +use DXUtil; + + +use vars qw($VERSION $BRANCH); +$VERSION = sprintf( "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/ ); +$BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/ || (0,0)); +$main::build += $VERSION; +$main::branch += $BRANCH; + +use vars qw (%list %valid); + +%list = (); # the list of outstanding investigations +%valid = ( # valid fields + call => '0,Callsign', + start => '0,Started at,atime', + version => '0,Node Version', + build => '0,Node Build', + here => '0,Here?,yesno', + conf => '0,In Conf?,yesno', + ); + + +sub new +{ + my $pkg = shift; + my $call = shift; + my $self = $list{$call} || bless { call=>$call, start=>$main::systime }, ref($pkg) || $pkg; + return $self; +} + +sub get +{ + return $list{$_[0]}; +} + +sub AUTOLOAD +{ + no strict; + my $name = $AUTOLOAD; + return if $name =~ /::DESTROY$/; + $name =~ s/^.*:://o; + + confess "Non-existant field '$AUTOLOAD'" if !$valid{$name}; + + # this clever line of code creates a subroutine which takes over from autoload + # from OO Perl - Conway + *$AUTOLOAD = sub {@_ > 1 ? $_[0]->{$name} = $_[1] : $_[0]->{$name}}; + goto &$AUTOLOAD; +} +1; diff --git a/perl/Route/Node.pm b/perl/Route/Node.pm index 83f5768c..0880622e 100644 --- a/perl/Route/Node.pm +++ b/perl/Route/Node.pm @@ -30,6 +30,7 @@ use vars qw(%list %valid @ISA $max $filterdef); usercount => '0,User Count', version => '0,Version', newroute => '0,New Routing?,yesno', + pingtime => '0,Ping Time', ); $filterdef = $Route::filterdef; -- 2.43.0