2 # Investigate whether an external node is accessible
4 # If it is, make it believable otherwise mark as not
7 # It is possible to store up state for a node to be
8 # investigated, so that if it is accessible, its details
9 # will be passed on to whomsoever might be interested.
11 # Copyright (c) 2004 Dirk Koopman, G1TLH
23 use vars qw($VERSION $BRANCH);
25 main::mkver($VERSION = q$Revision$);
27 use vars qw (%list %valid $pingint $maxpingwait);
29 $pingint = 5; # interval between pings for each investigation
30 # this is to stop floods of pings
31 $maxpingwait = 120; # the maximum time we will wait for a reply to a ping
32 my $lastping = 0; # last ping done
33 %list = (); # the list of outstanding investigations
34 %valid = ( # valid fields
36 start => '0,Started at,atime',
37 version => '0,Node Version',
38 build => '0,Node Build',
39 here => '0,Here?,yesno',
40 conf => '0,In Conf?,yesno',
41 pingsent => '0,Time ping sent,atime',
44 pcxx => '0,Stored PCProt,parray',
55 my $self = $list{"$via,$call"};
60 start=>$main::systime,
64 $list{"$via,$call"} = $self;
66 dbg("Investigate: New $call via $via") if isdbg('investigate');
72 return $list{"$_[1],$_[0]"};
79 dbg("Investigate: $self->{call} via $self->{via} state $self->{state}->$state") if isdbg('investigate');
80 $self->{state} = $state;
86 dbg("Investigate: ping received for $self->{call} via $self->{via}") if isdbg('investigate');
87 if ($self->{state} eq 'waitping') {
88 $via{$self->{via}} = 0; # cue up next ping on this interface
89 delete $list{"$self->{via},$self->{call}"};
90 my $user = DXUser->get_current($self->{via});
92 $user->set_believe($self->{call});
95 my $dxchan = DXChannel::get($self->{via});
97 dbg("Investigate: sending PC19 for $self->{call}") if isdbg('investigate');
98 foreach my $pc (@{$self->{pcxx}}) {
100 my $handle = "handle_$pc->[0]";
101 dbg("Investigate: sending PC$pc->[0] (" . join(',', @$pc) . ")") if isdbg('investigate');
102 my $regex = $pc->[1];
103 $regex =~ s/\^/\\^/g;
104 DXProt::eph_del_regex($regex);
105 $dxchan->$handle(@$pc);
114 dbg("Investigate: Storing (". join(',', @_) . ")") if isdbg('investigate');
115 push @{$self->{pcxx}}, [@_];
120 while (my ($k, $v) = each %list) {
121 if ($v->{state} eq 'start') {
122 my $via = $via{$v->{via}} || 0;
123 if ($main::systime > $via+$pingint) {
124 DXProt::addping($main::mycall, $v->{call}, $v->{via});
125 $v->{start} = $lastping = $main::systime;
126 dbg("Investigate: ping sent to $v->{call} via $v->{via}") if isdbg('investigate');
127 $v->chgstate('waitping');
128 $via{$v->{via}} = $main::systime;
130 } elsif ($v->{state} eq 'waitping') {
131 if ($main::systime > $v->{start} + $maxpingwait) {
132 dbg("Investigate: ping timed out on $v->{call} via $v->{via}") if isdbg('investigate');
134 my $user = DXUser->get_current($v->{via});
136 $user->lastping($v->{via}, $main::systime);
148 my $name = $AUTOLOAD;
149 return if $name =~ /::DESTROY$/;
152 confess "Non-existant field '$AUTOLOAD'" if !$valid{$name};
154 # this clever line of code creates a subroutine which takes over from autoload
155 # from OO Perl - Conway
156 *$AUTOLOAD = sub {@_ > 1 ? $_[0]->{$name} = $_[1] : $_[0]->{$name}};