#!/usr/perl5/5.00503/bin/perl
#---------------------------------------------------------------------
+------
# Program:  MevsLights.pl
# Desc:     Monitors MEVS Servers. If they acknowledge the 'status' qu
+ery
#                                  a "green" light is displayed, other
+wise
#                                  a "red" light is displayed indicati
+ng the
#                                  server has "stopped" be available.
#---------------------------------------------------------------------
+------

######################################################################
+######
use Tk;
######################################################################
+######

if ( ! Exists($ml) )
{
    @ipaddr     = ("server1","server2","server3");
    @port       = (1234,5678);        # 1234=online port, 5678=batch p
+ort
    $data       = "status";
    $system     = "";
    $server     = "";
    $rc         = "";
    @color      = ("green", "yellow", "red", "red");

    $login_title = "MEVSTOOL: User Security";

    $ml = MainWindow->new;
    $ml->title(" MEVS Monitor:  MevsLights.pl");

    get_time();

    $c = $ml->Canvas(-relief => 'groove')->pack(-fill => 'both', -expa
+nd => 1);

    # Set the row and column labels for the server (shoshone, lewis, c
+lark) in red, and the system (online, batch)in blue
    $c->createText(40,68, -text => "server1", -anchor => "w", -fill =>
+ "dark red", -font => "arial 12 bold");
    $c->createText(40,108, -text => "server2", -anchor => "w", -fill =
+> "dark red", -font => "arial 12 bold");
    $c->createText(40,148, -text => "server3", -anchor => "w", -fill =
+> "dark red", -font => "arial 12 bold");
    $c->createText(130,30, -text => "Online", -anchor => "w", -fill =>
+ "dark blue", -font => "arial 12 bold");
    $c->createText(200,30, -text => "Batch", -anchor => "w", -fill => 
+"dark blue", -font => "arial 12 bold");

    # Turn on the MEVS Lights
    turn_on_lights();    # turn lights on
 }

 &monitor;
 MainLoop;
 #####################################################################
+######
 sub turn_on_lights     #02/11/2005 11:47AM
 #####################################################################
+######
  {
    if ( $server eq "server1" ) {
        if ($system eq "4500") {           # online
            $c->createOval(140,58,160,78, -fill => "$color[$rc]", outl
+ine => "dark $color[$rc]");
            $data[0] = $rc;
        }
        else  {                           # batch
            $c->createOval(210,58,230,78, -fill => "$color[$rc]", outl
+ine => "dark $color[$rc]");
            $data[1] = $rc;
        }
    }
    elsif ( $server eq "server2" )  {
        if ($system eq "4500") {           # online
            $c->createOval(140,98,160,118, -fill => "$color[$rc]", out
+line => "dark $color[$rc]");
            $data[2] = $rc;
        }
        else  {                           # batch
            $c->createOval(210,98,230,118, -fill => "$color[$rc]", out
+line => "dark $color[$rc]");
            $data[3] = $rc;
        }
    }
    elsif ( $server eq "server3" )  {
        if ($system eq "4500") {           # online
            $c->createOval(140,138,160,158, -fill => "$color[$rc]", ou
+tline => "dark $color[$rc]");
            $data[4] = $rc;
        }
        else  {                           # batch
            $c->createOval(210,138,230,158, -fill => "$color[$rc]", ou
+tline => "dark $color[$rc]");
            $data[5] = $rc;
        }
    }

 }  ##turn_on_lights
######################################################################
+######
sub monitor     #02/14/2005 10:50AM
######################################################################
+######
 {
    while ( 1 )
    {
        foreach $server (@ipaddr)     # do for each of the servers
        {
            foreach $system (@port)   # do for each portno  (online/ba
+tch)
            {
                #-----------------------------------------------------
+--------------------------------
                #  Test status a maximum of 5 times or until a 'good' 
+status
                #  check return code [$rc] is received. This will prev
+ent unneeded emails
                #  being sent because of either MEVS or the Network be
+ing 'busy'.
                #-----------------------------------------------------
+--------------------------------
                $rc  = 9;     # Set return code to non-zero (9) value 
+so the while loop will work
                $cnt = 0;     # Set counter to zero, used to loop max 
+5 times before sending email
                while  (($rc != 0) && ($cnt <= 5))
                {
                   $sock = get_socket($server, $system);         # con
+nect to socket
                   if ( $sock eq "ERROR"  ) {                    # con
+nection error
                       $rc = 2;
                   }
                   else
                   {
                      $response = send_request($sock, $data);    # sen
+d 'status' request
                      if    ( $response eq "" )  {$rc = 3;}      # no 
+response (timeout)
                      elsif ( $response eq "1" ) {$rc = 1;}      # sta
+tus check failed
                      elsif ( $response eq "0" ) {$rc = 0;}      # sta
+tus check passed
                      else  { $rc = $response; }
                      close_socket($sock);                      # clos
+e socket
                      $cnt++;                                   # incr
+ loop count
                   }
                   sleep 1;                                     # slee
+p for 5 secs
                   $cnt++;                                      # incr
+ loop count
                }
                turn_on_lights();                                   # 
+Turn on the lights
                $ml->update;
            }
       }
       sleep 1
    }
}   ##monitor
######################################################################
+######
#             Socket Subroutines used by MevsLights                   
+     #
######################################################################
+######

#---------------------------------------------------------------------
+------
# Connect to the socket subroutine
# Requires arguments to be passed by calling module
#   1) IP Address
#   2) Port Number
#---------------------------------------------------------------------
+------
sub get_socket
{
    my  $ipaddr   =  $_[0];  # server IP Address passed
    my  $port     =  $_[1];  # Proxi-Port Number passed

    my  $sock     = "";
    my  $error    = "ERROR";

    # connect to the Statistics Server Socket
    use IO::Socket;
    $sock = new IO::Socket::INET (PeerAddr => $ipaddr,
                                  PeerPort => $port,
                                  Proto    => 'tcp',
                                 ) or  return $error;

    return $sock;     # return socket
}

#---------------------------------------------------------------------
+------
# Send the Status Request and Get Response to the socket
#---------------------------------------------------------------------
+------
sub send_request
{
    my  $sock      =  $_[0];     # assigns passed socket number
    my  $command   =  $_[1];     # "status" command
    my  $response  =  "";        # will hold data returned from server

    print $sock "$command\n"; # send request to server

# get response
    chomp ($response = <$sock>);   # retrieves data returned from serv
+er
    return $response;              # return response
}

#---------------------------------------------------------------------
+------
# Close Socket
#---------------------------------------------------------------------
+------
sub close_socket
{
    my $sock = $_[0];   # assigns the passed socket# to $sock variable
    close ($sock);      # closes the socket
}
#---------------------------------------------------------------------
+--
# End socket subroutines
#---------------------------------------------------------------------
+--

######################################################################
+##
[download]

Edit by castaway - Added readmore tags