1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
|
#!/usr/bin/perl
use POSIX ':sys_wait_h';
use strict;
# Main
my $quiet = 0;
while($ARGV[0] eq '-q') {
$quiet++;
shift(@ARGV);
}
usage() if ($#ARGV != 1);
my $sleeptime = sprintf('%d', $ARGV[1]);
die("$0: bad interval $ARGV[1]\n") if ($sleeptime < 2);
while (1) {
# Clean up any zombies
while (waitpid(-1, WNOHANG) > 0) { }
# Run the test
do_test();
# Sleep for the duration of the interval
my $slept = 0;
while ($slept < $sleeptime) {
$slept += sleep($sleeptime - $slept);
}
}
# Show usage and croak
sub usage() {
die <<"ENDUSAGE";
Usage: xr-client-ping [-q] WEBINTERFACE-URL INTERVAL
The web interface is queried for clients. Connections to non-pingable clients
are killed. The process is repeated each interval.
The arguments:
-q: quiet mode, suppresses verbose messaging
WEBINTERFACE-URL: the URL of XR's web interface, include http://
INTERVAL: number of seconds
ENDUSAGE
}
# Start a single test
my $_tries = 0;
sub do_test() {
msg ("-----------------------------------------------------------------\n");
msg ("Starting check run\n");
my $xml;
eval {
$xml = http_get($ARGV[0]);
};
if ($@) {
msg ("Could not access web interface: $@\n");
die ("Too many tries now, giving up...\n") if ($_tries++ > 5);
return;
}
$_tries = 0;
my $active = 0;
my ($id, $clientip);
for my $line (split(/\n/, $xml)) {
$active = 1 if ($line =~ /<thread>/);
$active = 0 if ($line =~ /<\/thread>/);
if ($active) {
if ($line =~ /<id>/) {
$id = $line;
$id =~ s/\s*<id>//;
$id =~ s/<\/id>.*//;
} elsif ($line =~ /<clientip>/) {
$clientip = $line;
$clientip =~ s/\s*<clientip>//;
$clientip =~ s/<\/clientip>//;
check_client($id, $clientip) if ($clientip ne '0.0.0.0');
}
}
}
}
# Check one thread ID and client IP
sub check_client($$) {
my ($id, $clientip) = @_;
msg ("Checking connection for client $clientip (XR thread $id)\n");
return if (fork());
my $cmd = "ping -c3 -t3 $clientip >/dev/null";
msg ("$clientip: pinging (external '$cmd')\n");
my $status = system($cmd);
if ($status != 0) {
msg ("$clientip: ping status '$status' $!\n");
msg ("$clientip: not reachable, stopping XR thread $id\n");
eval {
http_get("$ARGV[0]/thread/kill/$id");
};
msg ("Failed to stop thread $id\n") if ($@);
} else {
msg ("$clientip: reachable, connection assumed valid\n");
}
exit(0);
}
# Do a HTTP GET. Try LWP::UserAgent if available, else try wget.
sub http_get($) {
my $url = shift;
my $ua;
# Try LWP::UserAgent
eval {
require LWP::UserAgent;
};
if (! $@) {
$ua = LWP::UserAgent->new();
$ua->timeout(3);
my $res = $ua->get($url);
die ("Could not access url '$url'\n")
unless ($res->is_success());
return $res->content();
}
# Try wget or curl, or any other command (can be put in here)
for my $cmd ("wget -q -O- -T3 '$url'",
"curl --connect-timeout 3 -s '$url'") {
msg ("Running: $cmd\n");
open (my $if, "$cmd |");
if ($if) {
my $cont = '';
while (my $line = <$if>) {
$cont .= $line;
}
if (close($if)) {
return $cont;
} else {
msg("$cmd failed: $!\n");
}
}
}
# All failed, now what?
die ("No method to access url '$url'\n");
}
# Verbose messaging
sub msg {
print ($$, ' ', scalar(localtime()), ' ', @_) unless ($quiet);
}
|
