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
24 use vars qw (%list %valid $pingint $maxpingwait);
26 $pingint = 5; # interval between pings for each investigation
27 # this is to stop floods of pings
28 $maxpingwait = 120; # the maximum time we will wait for a reply to a ping
29 my $lastping = 0; # last ping done
30 %list = (); # the list of outstanding investigations
31 %valid = ( # valid fields
33 start => '0,Started at,atime',
34 version => '0,Node Version',
35 build => '0,Node Build',
36 here => '0,Here?,yesno',
37 conf => '0,In Conf?,yesno',
38 pingsent => '0,Time ping sent,atime',
41 pcxx => '0,Stored PCProt,parray',
52 my $self = $list{"$via,$call"};
57 start=>$main::systime,
61 $list{"$via,$call"} = $self;
63 dbg("Investigate: New $call via $via") if isdbg('investigate');
69 return $list{"$_[1],$_[0]"};
76 dbg("Investigate: $self->{call} via $self->{via} state $self->{state}->$state") if isdbg('investigate');
77 $self->{state} = $state;
83 dbg("Investigate: ping received for $self->{call} via $self->{via}") if isdbg('investigate');
84 if ($self->{state} eq 'waitping') {
85 $via{$self->{via}} = 0; # cue up next ping on this interface
86 delete $list{"$self->{via},$self->{call}"};
87 my $user = DXUser->get_current($self->{via});
89 $user->set_believe($self->{call});
92 my $dxchan = DXChannel::get($self->{via});
94 dbg("Investigate: sending PC19 for $self->{call}") if isdbg('investigate');
95 foreach my $pc (@{$self->{pcxx}}) {
97 my $handle = "handle_$pc->[0]";
98 dbg("Investigate: sending PC$pc->[0] (" . join(',', @$pc) . ")") if isdbg('investigate');
100 $regex =~ s/\^/\\^/g;
101 DXProt::eph_del_regex($regex);
102 $dxchan->$handle(@$pc);
111 dbg("Investigate: Storing (". join(',', @_) . ")") if isdbg('investigate');
112 push @{$self->{pcxx}}, [@_];
117 while (my ($k, $v) = each %list) {
118 if ($v->{state} eq 'start') {
119 my $via = $via{$v->{via}} || 0;
120 if ($main::systime > $via+$pingint) {
121 DXXml::Ping::add($main::me, $v->{call}, $v->{via});
122 $v->{start} = $lastping = $main::systime;
123 dbg("Investigate: ping sent to $v->{call} via $v->{via}") if isdbg('investigate');
124 $v->chgstate('waitping');
125 $via{$v->{via}} = $main::systime;
127 } elsif ($v->{state} eq 'waitping') {
128 if ($main::systime > $v->{start} + $maxpingwait) {
129 dbg("Investigate: ping timed out on $v->{call} via $v->{via}") if isdbg('investigate');
131 my $user = DXUser->get_current($v->{via});
133 $user->lastping($v->{via}, $main::systime);
145 my $name = $AUTOLOAD;
146 return if $name =~ /::DESTROY$/;
149 confess "Non-existant field '$AUTOLOAD'" if !$valid{$name};
151 # this clever line of code creates a subroutine which takes over from autoload
152 # from OO Perl - Conway
153 *$AUTOLOAD = sub {@_ > 1 ? $_[0]->{$name} = $_[1] : $_[0]->{$name}};