downer (1576B)
1 #!/usr/bin/env perl 2 3 use strict; 4 use XML::Simple; 5 use LWP::UserAgent; 6 use Data::Dumper; 7 8 # Check arguments 9 if ($#ARGV != 1) { 10 die << "ENDUSAGE"; 11 12 Usage: $0 webinterface-url period 13 Example: $0 http://localhost:20001 5 14 15 The XR web interface at the stated URL is checked for unavailable back ends. 16 Such back ends are taken offline. This is repeated each 'period' seconds. 17 18 ENDUSAGE 19 } 20 21 # Process 22 while (1) { 23 check($ARGV[0]); 24 sleep($ARGV[1]); 25 } 26 27 # Check the web interface. Take unavailable back ends offline. 28 sub check($) { 29 my $url = shift; 30 31 # Access web interface 32 my $ua = LWP::UserAgent->new(); 33 my $resp = $ua->get($url); 34 if (! $resp->is_success()) { 35 warn("Failed to access the XR web interface on '$url': ", 36 $resp->status_line(), "\n"); 37 return; 38 } 39 40 # Parse the XML 41 my $xml; 42 eval { 43 $xml = XMLin($resp->content()); 44 }; 45 if ($@) { 46 warn("Failed to parse web interface response: $@\n"); 47 return; 48 } 49 50 # print Dumper $xml; 51 52 my @backends = @{ $xml->{backend} }; 53 for my $b (@backends) { 54 print("Back end ", $b->{nr}, " at ", $b->{address}, 55 ": available=", $b->{available}, " up=", $b->{up}, "\n"); 56 if ($b->{available} ne 'available' and $b->{up} eq 'up') { 57 print(" Marking back end as 'down'.\n"); 58 my $resp = $ua->get($url . '/backend/' . $b->{nr} . '/up/0'); 59 warn("Failed to mark back end down: ", $resp->status_line(), "\n") 60 unless ($resp->is_success()); 61 } 62 } 63 } 64 65