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