+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.
version => '1,Node Version',
build => '1,Node Build',
verified => '9,Verified?,yesno',
+ newroute => '1,New Style Routing,yesno',
);
use vars qw($VERSION $BRANCH);
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
{
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;
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;
# 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;
}
use Route;
use Route::Node;
use Script;
+use Investigate;
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
+ $investigation_int $pc19_version
%nodehops $baddx $badspotter $badnode $censorpc $rspfcheck
$allowzero $decode_dk0wcy $send_opernam @checklist);
$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 =
(
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;
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,
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');
my $i;
my $newline = "PC19^";
- if (eph_dup($line)) {
- dbg("PCPROT: dup PC19 detected") if isdbg('chanerr');
- return;
- }
-
# new routing list
my @rout;
$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);
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;
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;
+ }
}
- }
+ }
}
}
}
}
}
+ Investigate::process();
+
# every ten seconds
if ($t - $last10 >= 10) {
# clean out ephemera
# 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
$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;
}
version => '1,Version',
build => '1,Build',
believe => '1,Believable nodes,parray',
+ lastping => '1,Last Ping at,ptimelist',
);
#no strict;
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
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__
@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
);
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
{
--- /dev/null
+#
+# 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;
projects / spider.git / commitdiff