From 23d5848190b73200389fdfc2291e3453b3b91b15 Mon Sep 17 00:00:00 2001 From: minima Date: Wed, 28 Jul 2004 14:07:45 +0000 Subject: [PATCH] added Investigate and believing --- Changes | 3 + perl/DXChannel.pm | 16 ++++- perl/DXProt.pm | 102 +++++++++++++++++++++++----- perl/DXUser.pm | 20 +++++- perl/DXUtil.pm | 15 ++++- perl/Investigate.pm | 158 ++++++++++++++++++++++++++++++++++++++++++++ 6 files changed, 291 insertions(+), 23 deletions(-) create mode 100644 perl/Investigate.pm diff --git a/Changes b/Changes index 3ac0fd7a..91568a35 100644 --- a/Changes +++ b/Changes @@ -1,3 +1,6 @@ +28Jul04======================================================================= +1. backported 'Investigate' from NP branch so that only pingable nodes +are 'believed'. 26Jul04======================================================================= 1. added extra variables to Internet.pm to allow the various internet query commands to alter the url that they use. diff --git a/perl/DXChannel.pm b/perl/DXChannel.pm index 3b3ac62f..829c6b55 100644 --- a/perl/DXChannel.pm +++ b/perl/DXChannel.pm @@ -113,6 +113,7 @@ $count = 0; version => '1,Node Version', build => '1,Node Build', verified => '9,Verified?,yesno', + newroute => '1,New Style Routing,yesno', ); use vars qw($VERSION $BRANCH); @@ -302,6 +303,15 @@ sub sort return @_ ? $self->{'sort'} = shift : $self->{'sort'} ; } +# find out whether we are prepared to believe this callsign on this interface +sub is_believed +{ + my $self = shift; + my $call = shift; + + return grep $call eq $_, $self->user->believe; +} + # handle out going messages, immediately without waiting for the select to drop # this could, in theory, block sub send_now @@ -514,7 +524,7 @@ sub rspfcheck { my ($self, $flag, $node, $user) = @_; my $nref = Route::Node::get($node); - my $dxchan = $nref->dxchan if $nref; + my $dxchan = $nref->bestdxchan if $nref; if ($nref && $dxchan) { if ($dxchan == $self) { return 1 unless $user; @@ -523,7 +533,7 @@ sub rspfcheck return 1 if @users == 0 || grep $user eq $_, @users; dbg("RSPF: $user not on $node") if isdbg('chanerr'); } else { - dbg("RSPF: Shortest path for $node is " . $nref->dxchan->{call}) if isdbg('chanerr'); + dbg("RSPF: Shortest path for $node is " . $nref->bestdxchan->{call}) if isdbg('chanerr'); } } else { return 1 if $flag; @@ -637,7 +647,7 @@ sub AUTOLOAD # 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; + goto &$AUTOLOAD; } diff --git a/perl/DXProt.pm b/perl/DXProt.pm index 0d222859..8903f121 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; @@ -45,6 +46,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 + $investigation_int $pc19_version %nodehops $baddx $badspotter $badnode $censorpc $rspfcheck $allowzero $decode_dk0wcy $send_opernam @checklist); @@ -71,6 +73,8 @@ $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 = ( @@ -671,17 +675,12 @@ sub handle_16 my $line = shift; my $origin = shift; - if (eph_dup($line)) { - dbg("PCPROT: dup PC16 detected") if isdbg('chanerr'); - return; - } - # general checks my $dxchan; my $ncall = $_[1]; my $newline = "PC16^"; - # do I want users from this channel? + # dos I want users from this channel? unless ($self->user->wantpc16) { dbg("PCPROT: don't send users to $self->{call}") if isdbg('chanerr'); return; @@ -691,6 +690,21 @@ sub handle_16 dbg("PCPROT: trying to alter config on this node from outside!") if isdbg('chanerr'); return; } + + # 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; + } + + if (eph_dup($line)) { + dbg("PCPROT: dup PC16 detected") if isdbg('chanerr'); + return; + } + my $parent = Route::Node::get($ncall); # if there is a parent, proceed, otherwise if there is a latent PC19 in the PC19list, @@ -830,6 +844,15 @@ sub handle_17 return; } + # 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; + } + my $uref = Route::User::get($ucall); unless ($uref) { dbg("PCPROT: Route::User $ucall not in config") if isdbg('chanerr'); @@ -907,11 +930,6 @@ sub handle_19 my $i; my $newline = "PC19^"; - if (eph_dup($line)) { - dbg("PCPROT: dup PC19 detected") if isdbg('chanerr'); - return; - } - # new routing list my @rout; @@ -977,6 +995,26 @@ sub handle_19 $user->node($call); } + # do we believe this call? + my $genline = "PC19^$here^$call^$conf^$ver^$_[-1]^"; + unless ($call eq $self->{call} || $self->is_believed($call)) { + my $pt = $user->lastping($self->{call}) || 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,$genline,$origin,'PC19',$here,$call,$conf,$ver,$_[-1]); + } else { + dbg("PCPROT: We don't believe $call on $self->{call}"); + } + next; + } + + if (eph_dup($genline)) { + dbg("PCPROT: dup PC19 for $call detected") if isdbg('chanerr'); + next; + } + my $r = Route::Node::get($call); my $flags = Route::here($here)|Route::conf($conf); @@ -1058,6 +1096,15 @@ sub handle_21 return; } + # check if we believe this + 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; + } + # check to see if we are in the pc19list, if we are then don't bother with any of # this routing table manipulation, just remove it from the list and dump it my @rout; @@ -1470,21 +1517,28 @@ sub handle_51 my $nopings = $tochan->user->nopings || $obscount; push @{$tochan->{pingtime}}, $t; shift @{$tochan->{pingtime}} if @{$tochan->{pingtime}} > 6; - - # cope with a missed ping, this means you must set the pingint large enough + + # cope with a missed ping, this means you must set the pingint large enough if ($t > $tochan->{pingint} && $t < 2 * $tochan->{pingint} ) { $t -= $tochan->{pingint}; } - - # calc smoothed RTT a la TCP + + # calc smoothed RTT a la TCP if (@{$tochan->{pingtime}} == 1) { $tochan->{pingave} = $t; } else { $tochan->{pingave} = $tochan->{pingave} + (($t - $tochan->{pingave}) / 6); } $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 (my $ivp = Investigate::get($from, $self->{call})) { + $ivp->handle_ping; + } } - } + } } } } @@ -1626,6 +1680,8 @@ sub process } } + Investigate::process(); + # every ten seconds if ($t - $last10 >= 10) { # clean out ephemera @@ -2058,14 +2114,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(($via || $from), $main::systime); + $u->put; + } } sub process_rcmd @@ -2389,6 +2454,7 @@ sub eph_dup $s =~ s/\^H\d\d?\^?\~?$//; $r = 1 if exists $eph{$s}; # pump up the dup if it keeps circulating $eph{$s} = $main::systime + $t; + dbg("PCPROT: emphemeral duplicate") if $r && isdbg('chan'); return $r; } diff --git a/perl/DXUser.pm b/perl/DXUser.pm index f371161b..8bbd0fbc 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,ptimelist', ); #no strict; @@ -784,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 @@ -796,6 +797,23 @@ sub unset_believe delete $self->{believe} unless @{$self->{believe}}; } } + +sub believe +{ + my $self = shift; + return exists $self->{believe} ? @{$self->{believe}} : (); +} + +sub lastping +{ + my $self = shift; + my $call = shift; + $self->{lastping} ||= {}; + $self->{lastping} = {} unless ref $self->{lastping}; + my $b = $self->{lastping}; + $b->{$call} = shift if @_; + return $b->{$call}; +} 1; __END__ diff --git a/perl/DXUtil.pm b/perl/DXUtil.pm index 705e5cc6..9f411812 100644 --- a/perl/DXUtil.pm +++ b/perl/DXUtil.pm @@ -27,7 +27,7 @@ require Exporter; @ISA = qw(Exporter); @EXPORT = qw(atime ztime cldate cldatetime slat slong yesno promptf parray parraypairs phex shellregex readfilestr writefilestr - filecopy + filecopy ptimelist print_all_fields cltounix unpad is_callsign is_latlong is_qra is_freq is_digits is_pctext is_pcflag insertitem deleteitem ); @@ -162,6 +162,19 @@ sub phex return sprintf '%X', $val; } +# take an arg as a hash of call=>time pairs and print it +sub ptimelist +{ + my $ref = shift; + my $out; + for (sort keys %$ref) { + $out .= "$_=$ref->{$_}, "; + } + chop $out; + chop $out; + return $out; +} + # take an arg as an array list and print it sub parray { diff --git a/perl/Investigate.pm b/perl/Investigate.pm new file mode 100644 index 00000000..d59a57b5 --- /dev/null +++ b/perl/Investigate.pm @@ -0,0 +1,158 @@ +# +# 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 $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', + start => '0,Started at,atime', + version => '0,Node Version', + 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', + ); + + +sub new +{ + my $pkg = shift; + my $call = shift; + 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{"$_[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'); + my $regex = $pc->[1]; + $regex =~ s/\^/\\^/g; + DXProt::eph_del_regex($regex); + $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($v->{via}, $main::systime); + $user->put; + } + } + } + } +} + + +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; -- 2.43.0