Roth Consulting Perl Script: UpTimeMon.pl

#  UpTimeMonitor.pl
#  ----------------------------------------
#  From "Win32 Perl Programming: Administrators Handbook" by Dave Roth
#  Published by New Riders Publishing.
#  ISBN # 1-57870-215-1
#
#  This script is a daemon that monitors machines and triggers an alert
#  if the machine is down.
use Getopt::Long;
use Win32::Daemon;
use Win32::EventLog;
use Win32::EventLog::Message;
                                     
# How long to wait for a ping ($PING_TIMEOUT), how long to wait between
# ping attempts ($PING_INTERVAL) and how many pings to try before 
# concluding that a server is down ($PING_MAX_COUNT)
$PING_TIMEOUT = 5;
$PING_INTERVAL = 10;
$PING_MAX_COUNT = 5;

# How much time do we sleep between polling the service state?
$SERVICE_SLEEP_TIME = 5;

# The list of machines to monitor
@HOSTS = qw(
              127.0.0.1
              192.168.3.22
              www.roth.net
);

$SERVICE_ALIAS = "UpMon";
$SERVICE_NAME = "Server Uptime Monitor";
$LOG_FILE_PATH = ( Win32::GetFullPathName( $0 ) =~ /^(.*)?\.[^.]*$/ )[0];
$LOG_FILE_PATH .= ".log";

%Config = (
   logfile => $LOG_FILE_PATH,
);
Configure( \%Config, @ARGV );
if( $Config{install} )
{
    InstallService();
    exit;
}
elsif( $Config{remove} )
{
    RemoveService();
    exit;
}
elsif( $Config{help} )
{
    Syntax();
    exit;
}

# Register our simple Event Log message table resource DLL with
# the System Event Log's $SERVICE_NAME source
Win32::EventLog::Message::RegisterSource( 'System', $SERVICE_NAME );

# Try to open the log file
if( open( LOG, ">$Config{logfile}" ) )
{
    # Select the LOG filehandle...
    my $BackupHandle = select( LOG );
    # ...then turn on autoflush (no buffering)...
    $| = 1;
    # ...then restore the previous selected I/O handle
    select( $BackupHandle );
}

# Initialize servers...
foreach my $Host ( @HOSTS )
{
    $Servers->{lc $Host}->{count} = $PING_MAX_COUNT;
}

# Start the service...
if( ! Win32::Daemon::StartService() )
{
    ReportError( "Could not start the $0 service" );
    exit();
}

$PrevState = SERVICE_STARTING;
Write( "$SERVICE_NAME service is starting...\n" );
while( SERVICE_STOPPED != ( $State = Win32::Daemon::State() ) )
{
    if( SERVICE_START_PENDING == $State )
    {
        # Initialization code
        if( $PingObject = Net::Ping->new( "icmp", $PING_TIMEOUT ) )
        {
            ReportInfo( "Monitoring hosts:\n    " 
                        . join( ", ", @HOSTS ) );
            Win32::Daemon::State( SERVICE_RUNNING );
            ReportInfo( "$SERVICE_NAME service has started." );
            $PrevState = SERVICE_RUNNING;
        }
        else
        {
            Win32::Daemon::State( SERVICE_STOPPED );
            ReportError( "$SERVICE_NAME service could not create "
                         . "a Ping object: Aborting." );
        }
    }
    elsif( SERVICE_PAUSE_PENDING == $State )
    {
        # "Pausing...";
        Win32::Daemon::State( SERVICE_PAUSED );
        ReportWarn( "$SERVICE_NAME service has paused." );
        $PrevState = SERVICE_PAUSED;
        next;
    }
    elsif( SERVICE_CONTINUE_PENDING == $State )
    {
        # "Resuming...";
        Win32::Daemon::State( SERVICE_RUNNING );
        ReportInfo( "$SERVICE_NAME service has resumed." );
        $PrevState = SERVICE_RUNNING;
        next;
    }
    elsif( SERVICE_STOP_PENDING == $State )
    {
        # "Stopping...";
        $PingObject->close();
        undef $PingObject;
        Win32::Daemon::State( SERVICE_STOPPED );
        ReportWarn( "$SERVICE_NAME service is stopping." );
        $PrevState = SERVICE_STOPPED;
        next;
    }
    elsif( SERVICE_RUNNING == $State )
    {
        # The service is running as normal...
        if( time() > $NextPingTime )
        {
            PingServers( $PingObject, \%Servers, @HOSTS );
            $NextPingTime = time() + $PING_INTERVAL;
        }
    }
    else
    {
        # Got an unhandled control message. Set the state to
        # whatever the previous state was.
        Write( "Got odd state $State. Setting state to '$PrevState'" );
        Win32::Daemon::State( $PrevState );
    }
    CheckServers( \%Servers );
    sleep( $SERVICE_SLEEP_TIME );
}

sub PingServers
{
    my( $PingObject, $Servers, @Hosts ) = @_;

    return unless( defined $PingObject );

    foreach my $Host ( @HOSTS )
    {
        if( ! $PingObject->ping( $Host ) )
        {
            $Servers->{lc $Host}->{count}--;
        }
        else
        {
            $Servers->{lc $Host}->{count} = $PING_MAX_COUNT;
        }
    }
    return;
}

sub CheckServers
{
    my( $Servers ) = @_;

    foreach $Host ( keys %$Servers )
    {
        if( 0 >= $Servers->{lc $Host}->{count} )
        {
            ReportServerDown( $Host );
            $Servers->{lc $Host}->{count} = $PING_MAX_COUNT;
        }
    }
}

sub ReportServerDown
{
    my( $Host ) = @_;
    my $Error = "Server '$Host' is reported down at " . localtime();

    ReportError( $Error );
    Alert( $Host );
}

sub ReportError
{
    my( $Message) = @_;
    return( Report( $Message, 
                    $SERVICE_NAME, 
                    EVENTLOG_ERROR_TYPE ) );
}

sub ReportWarn
{
    my( $Message ) = @_;
    return( Report( $Message, 
                    $SERVICE_NAME, 
                    EVENTLOG_WARNING_TYPE ) );
}

sub ReportInfo
{
    my( $Message) = @_;
    return( Report( $Message, 
                    $SERVICE_NAME, 
                    EVENTLOG_INFORMATION_TYPE ) );
}

sub Report
{
    my( $Message, $Log, $Type ) = @_;

    Write( "$Message\n" );
    if( my $EventLog = new Win32::EventLog( $Log ) )
    {
        $EventLog->Report(
            {
                Strings => $Message,
                EventID => 0,
                EventType => $Type,
                Category    => undef,
            }
        );
        $EventLog->Close();
    }
}
 
sub InstallService
{
    my $Service = GetService();
    
    $Service->{parameters} .= " -l \"$Config{logfile}\"";
    foreach my $Host ( @{$Config{address}} )
    {
      $Service->{parameters} .= " -a \"$Host\"";
    }
    if( Win32::Daemon::CreateService( $Service ) )
    {
        print "The $Service->{display} was successfully installed.\n";
    }
    else
    {
        print "Failed to add the $Service->{display} service.\n";
        print "Error: " . GetError() . "\n";
    }
}

sub RemoveService
{
    my $Service = GetService();
    
    if( Win32::Daemon::DeleteService( $Service->{name} ) )
    {
        print "The $Service->{display} was successfully removed.\n";
    }
    else
    {
        print "Failed to remove the $Service->{display} service.\n";
        print "Error: " . GetError() . "\n";
    }
}

sub GetService
{
    my $ScriptPath = join( "", Win32::GetFullPathName( $0 ) );
    my %Hash = (
        name    => $SERVICE_ALIAS,
        display => $SERVICE_NAME,
        path    => Win32::GetFullPathName( $^X ),
        user    => $Config{user},
        pwd     => $Config{password},
        description => "Monitors remote machine's uptime.",
        parameters => "\"$ScriptPath\" " . join( " ", $Config{runtime_options} ),
    );
    return( \%Hash );
}

sub GetError
{
    return( Win32::FormatMessage( Win32::Daemon::GetLastError() ) );
}

sub Write
{
    my( $Message ) = @_;
    $Message = "[" . scalar( localtime() ) . "] $Message";
    if( fileno( LOG ) )
    {
        print LOG $Message;
    }
}
 
sub Alert
{
    my( $Host ) = @_;
    # You could add code here to alert administrators via email,
    # pager, network message or some other means.
} 

sub LoadDatabase 
{
  my( $Path ) = @_;
  my @HostList;
  if( open( HOSTDB, "<$Path" ) )
  {
    while( my $Line = <HOSTDB> )
    {
      my $Host;
      next unless( $Line =~ /\s*[#;]/ );
      next unless( $Line =~ /\S/ );
      if( ( $Host ) = ( $Line =~ /\s*(\w+)/ ) )
      {
        push( @HostList, $Host );
      }
    }
  }
  return( @HostList );
}

sub Configure
{
    my( $Config, @Args ) = @_;
    my $Result;

    Getopt::Long::Configure( "prefix_pattern=(-|\/)" );
    $Result = GetOptions( $Config, 
                            qw(
                                install|i
                                remove|r
                                logfile|l=s
                                dbfile|d=s
                                nolog|n
                                user|u|a|account=s
                                password=s
                                address|a=s@
                                help
                            )
                        );
    $Config->{help} = 1 if( ! $Result );
    push( @{$Config->{runtime_options}}, "-nolog" ) if( $Config->{nolog} );
    push( @{$Config->{runtime_options}}, "-logfile \"$Config->{logfile}\"" ) if( "" ne $Config->{logfile} );
    push( @{$Config->{runtime_options}}, "-dbfile \"$Config->{dbfile}\"" ) if( "" ne $Config->{dbfile} );
    push( @{$Config->{runtime_options}}, @{$Config->{address}} ) if( scalar @{$Config->{address}} );
}

sub Syntax
{
    my( $Script ) = ( $0 =~ /([^\\]*?)$/ );
    my $Whitespace = " " x length( $Script );
    print<< "EOT";

Syntax:
    $Script -install [-account Account][-password Password]
            [-l Logfile | -n]
            [-d DatabaseFile]
            [-a Address [-a Address2 ...]]
    $Whitespace -remove
    $Whitespace -help
    
        -install...........Installs the service.
            -account.......Specifies account the service runs under. 
                           Default: Local System
            -password......Specifies the password the service uses.
            -l.............Specifies a log file path.
                           Default: $LOG_FILE_PATH
            -n.............Do not use a log file.
            -d.............Use the specified database file.
                           Text file with list of address to monitor. One
                           address per line. Comment lines start with # or ;
            -a.............Specifies what IP address to monitor.
                           Specify as many as needed.                           
        -remove............Removes the service.
EOT
}
	Are you searching for a children's bike trailer?
	Would you like to try growing an avocado plant?
	Easily lose weight by increasing your metabolism.
	What, exactly, is a Calorie?
	Want to know about schooling your child using the Montessori method.
`Name:`	`UpTimeMon.pl`
`Version:`	`20020602`
`Last Updated:`	`2002.07.22`
`Author:`	`Dave Roth`
`Description:`	`Monitors servers and updates Win32 Event Log when a server is down.`
`Explanation:`	`This script requires a database file that has a file name which is the same as the script's file name except that the file exstension must be .db. So if the script is named UpTimeMon.pl the database file is UpTimeMon.db. The database file must be in the same directory as the script.` `This script is taken from the book, Win32 Perl Scripting: The Administrator's Handbook ( http://www.roth.net/books/handbook/ ).`
Perl Script: UpTimeMon.pl

The UpTimeMon.pl Script:
