[dw-free] requested fix for pbadm

[mark]

[commit: http://hg.dwscoalition.org/dw-free/rev/02dc361587b1]

http://bugs.dwscoalition.org/show_bug.cgi?id=1211

Updates to pbadm so it shows a down Perlbal.

Patch by kareila.

Files modified:

• bin/pbadm

--------------------------------------------------------------------------------
diff -r 0c02bbf9f08f -r 02dc361587b1 bin/pbadm
--- a/bin/pbadm	Mon May 18 00:13:33 2009 +0000
+++ b/bin/pbadm	Mon May 18 00:16:19 2009 +0000
@@ -36,7 +36,7 @@ require "$ENV{LJHOME}/etc/config-private
 require "$ENV{LJHOME}/etc/config-private.pl";
 my %hostinfo = %LJ::PERLBAL_SERVERS;
 die "\%LJ::PERLBAL_SERVERS not found, please check config" unless %hostinfo;
-my @servers = sort keys %LJ::PERLBAL_SERVERS;
+my @servers = sort keys %hostinfo;
 
 ### INITIALIZE NETWORK VARIABLES ###
 my %tcp; my %s1; my %s2;
@@ -45,6 +45,7 @@ foreach (@servers)
     $tcp{$_} = new Net::Telnet (Timeout => $timeout, Telnetmode => 0);
     my ($host, $port) = split ':', $hostinfo{$_};
     $tcp{$_}->host($host); $tcp{$_}->port($port);
+    $tcp{$_}->errmode('return'); # don't die on connfail
     $tcp{$_}->prompt('/\.$/'); # Perlbal end-of-data marker
     $tcp{$_}->open(); # should stay open
 }
@@ -55,8 +56,15 @@ until (0 > 1)
     my $timestr = time2str("%a %b %d %T %Y", time);
     foreach my $server (@servers)
     {
-        my $bh_xfer=0; my $bh_wait=0; my $backend=0;
         my @states = $tcp{$server}->cmd('states');
+        unless (@states)
+        {
+            $s1{$server} = 'DWN';
+            $s2{$server} = 'DOWN';
+            $tcp{$server}->open(); # try to reopen
+            next;
+        }
+        my $bh_xfer = 0; my $bh_wait = 0; my $backend = 0;
         foreach (@states)
         {
             $bh_xfer = $1 if /Perlbal::BackendHTTP xfer_res (\d+)/;
@@ -69,7 +77,7 @@ until (0 > 1)
     print "$timestr: ";
     foreach (@servers)
     {
-        my $n = $s2{$_};
+        my $n = ($s2{$_} eq 'DOWN') ? $sev3 * 10 : $s2{$_};
         print color $sev4_color if ($n > $sev3);
         print color $sev3_color if ($n > $sev2 && $n <= $sev3);
         print color $sev2_color if ($n > $sev1 && $n <= $sev2);
--------------------------------------------------------------------------------