http://www.perlmonks.org?node_id=136141
Category: Utility Scripts
Author/Contact Info Kurt Kincaid (sifukurt@yahoo.com)
Description: I've been working a lot with Perl/Tk recently (mostly just for fun), and I needed a script that would verify that a list of servers were active. So I combined the two things and ended up with PingSweep. It reads the servers out of an XML file (default name of the XML file is "hostdata.xml"), and the specifications for the XML file are included in the help text. It defaults to pinging the servers 20 times every 90 seconds, and sends an email to a specified address if any of the servers fail to respond. All of those options can be modified from the command line via Getopt::Long.

Hopefully you'll find it useful. As always, feedback is welcome.
#--------------------------------------------------------------------#
# PingSweep
#       Date Written:   27-Nov-2001 11:41:02 AM
#       Last Modified:  03-Jan-2002 02:20:15 PM
#       Author:    Kurt Kincaid
#       Copyright (c) 2001, Kurt Kincaid
#           All Rights Reserved
#
# This is freesoftware and may be modified and/or redistributed
# under the same terms as Perl itself.
#--------------------------------------------------------------------#

use Tk;
use Tk::Dialog;
use Tk::DialogBox;
use Tk::Text;
use Tk::Menu;
use Tk::Menubutton;
use Tk::widgets qw(Menu);
use Net::Ping;
use IO::File;
use FileHandle;
use Time::HiRes qw( gettimeofday tv_interval );
use DBI;
use constant;
use Math::NumberCruncher;
use Getopt::Long;
use Mail::Sendmail;
use strict;
use Math::BigInt::Calc;
use DBD::AnyData;
use AnyData::Format::XML;
use AnyData::Storage::PassThru;
use vars
  qw( $iterations $opt_n $title $mw $t $sth $ref $p $name $button $cou
+nt @button @label
  $t0 $resp $elapsed $PingSweep $now $PingSweepLabel $total $info $ip 
+@elapsed $VERSION
  %mail $address $message %previous $m $update $hostfile $opt_f $opt_r
+ $repeat $seconds
  $opt_h $opt_a $subject $opt_x $noemail $opt_v $desc );

GetOptions( 'help' => \$opt_h, 'pings=i' => \$opt_n, 'email=s' => \$op
+t_a,
            'file=s' => \$opt_f, 'recur=i' => \$opt_r, 'xml' => \$opt_
+x,
            'noemail' => \$noemail, 'version' => \$opt_v );

if ( $opt_r ) {
    $opt_r *= 1000;
}

#--------------------------------------------------------------------#
# Change the following addresses to suit your needs.
#--------------------------------------------------------------------#
my $default_addr = 'someaddress@somedomain.com';
my $from_addr    = 'someaddress@somedomain.com';

$iterations = $opt_n || 20;
$hostfile   = $opt_f || "./hostdata.xml";
$repeat     = $opt_r || 90000;
$seconds    = $repeat / 1000;
$update     = "03-Jan-2002 02:20:15 PM";
$address    = $opt_a || $default_addr;
$subject    = "SERVER UNAVAILABLE!";

$| = 1;

$VERSION = "1.01a";
$title = "PingSweep v$VERSION";

if ( $opt_v ) {
    print $title;
    exit;
}

if ( $opt_h ) {
    print HelpText();
    exit;
}

if ( $opt_x ) {
    print HelpDetail();
    exit;
}

my $dbh = DBI->connect( "dbi:AnyData(RaiseError=>1):" );
$dbh->func( 'hosts', 'XML', $hostfile, 'ad_import' );

$mw = Tk::MainWindow->new();
$mw->title( $title );

$m = $mw->Frame( -relief => 'groove', -bd => 2 )
  ->pack( -side => 'top', -anchor => 'n', -fill => 'x' );

$m->Menubutton(
    -text      => "File",
    -tearoff   => 0,
    -menuitems => [
        [
            "command" => "Exit",
            -command => sub { exit }
        ]
    ]
)->pack( -side => 'left' );

$m->Menubutton(
    -text      => "Help",
    -tearoff   => 0,
    -menuitems => [
        [
            "command" => "Help...",
            -command  => \&help
        ],
        [
            "command" => "About...",
            -command  => \&about
        ]
    ]
)->pack( -side => 'left' );

$t = $mw->Scrolled("Text",
    -width      => 82,
    -height     => 38,
    -cursor     => 'arrow',
    -wrap       => 'word',
    -background => '#808080',
    -scrollbars => 'e'
)->pack( -expand => 1, -fill => 'both' );

$sth = $dbh->prepare( "SELECT * FROM hosts ORDER BY hostname" );
$sth->execute();

while ( $ref = $sth->fetchrow_hashref() ) {
    $p = Net::Ping->new( "icmp", 1 );
    $name   = $ref->{ hostname };
    $button = "button" . $count;
    $count++;
    $button[ $count ] = $t->Button(
        -width   => 30,
        -command => [ \&Ping, $count ],
        -cursor  => 'hand2',
        -text    => "$ref->{hostname} ($ref->{ip_address})"
    )->pack( -side => 'left', -anchor => 'w' );
    $t->windowCreate( 'end', -window => $button[ $count ] );

    $t0      = [ gettimeofday ];
    $resp    = $p->ping( $ref->{ ip_address } );
    $elapsed = sprintf( "%.2f", tv_interval( $t0 ) );

    if ( $resp ) {
        $button[ $count ]->configure(
            -foreground       => 'black',
            -background       => 'green',
            -activeforeground => 'white',
            -activebackground => 'blue'
        );
    } else {
        $elapsed = "n/a";
        $button[ $count ]->configure(
            -foreground       => 'yellow',
            -background       => 'red',
            -activeforeground => 'white',
            -activebackground => 'blue'
        );
    }

    $label[ $count ] = $t->Label(
        -background => '#808080',
        -foreground => 'white',
        -width      => 60,
        -cursor     => 'arrow',
        -text       => "Ping: $elapsed"
    )->pack( -side => 'left', -anchor => 'w' );
    $t->windowCreate( 'end', -window => $label[ $count ] );
    $t->insert( 'end', "\n" );
}

$PingSweep = $t->Button(
    -command => \&PingSweep,
    -cursor  => 'hand2',
    -width   => 30,
    -text    => "PingSweep"
)->pack( -side => 'bottom' );
$PingSweep->configure(
    -foreground       => 'black',
    -background       => 'yellow',
    -activeforeground => 'yellow',
    -activebackground => 'black'
);
$t->windowCreate( 'end', -window => $PingSweep );

$PingSweepLabel = $t->Label(
    -background => '#808080',
    -foreground => 'white',
    -width      => 60,
    -cursor     => 'arrow',
    -text       => "Last PingSweep: Never"
)->pack( -side => 'left', -anchor => 'w' );
$t->windowCreate( 'end', -window => $PingSweepLabel );

$total = scalar @button - 1;
$sth->finish();
$dbh->disconnect();

$mw->Label( -textvariable => \$info, -relief => 'ridge' )->pack( -side
+ => 'bottom', -fill => 'x' );

if ( $noemail ) {
    $desc = " -- NOT SENDING EMAIL";
} else {
    $desc = "";
}

$info = $title . " -- Auto PingSweep every $seconds seconds$desc";

$mw->repeat( $repeat, \&PingSweep );
MainLoop();

sub Ping {
    my $num  = shift;
    my $text = $button[ $num ]->cget( '-text' );
    $text =~ m/^(.*) \((.*)\)$/;
    $name = $1;
    $ip   = $2;
    $p    = Net::Ping->new( "icmp", 1 );
    my $success = 0;
    my $failure = 0;
    undef @elapsed;
    my $failed = 0;

    for ( 1 .. $iterations ) {
        if ( $failure == 5 && $success == 0 ) {
            $failed = 1;
            last;
        }
        $t0   = [ gettimeofday ];
        $resp = $p->ping( $ip );
        if ( $resp ) {
            $elapsed = tv_interval( $t0 );
            push ( @elapsed, $elapsed );
            $success++;
        } else {
            $failure++;
        }
        Time::HiRes::usleep( 10_000 );
    }
    my $percent = sprintf( "%.2f", ( $success / $iterations ) * 100 );
    my ( $high, $low ) = Math::NumberCruncher::Range( \@elapsed );
    $high = sprintf( "%.2f", $high );
    $low  = sprintf( "%.2f", $low );
    if ( $high eq "" ) { $high = 0 }
    if ( $low eq "" )  { $low  = 0 }
    my $mean;

    if ( $failed ) {
        my $current = time();
        if ( $current - $previous{ $ip } > 900 && ! $noemail ) {
            $now = localtime();
            my $subj = $subject . " ($ip)";
            $message = "Time:       $now\nHostname:   $name\nIP Addres
+s: $ip\n";
            $previous{ $ip } = $current;
            %mail = (
                To      => $address,
                From    => $from_addr,
                Message => $message,
                Subject => $subj
            );
            sendmail( %mail ) or die $Mail::Sendmail::error;
        }
        $mean = "n/a";
    } else {
        $mean = sprintf( "%.3f", Math::NumberCruncher::Mean( \@elapsed
+ ) );
    }
    if ( $resp ) {
        $button[ $num ]->configure( -foreground => 'black', -backgroun
+d => 'green' );
    } else {
        $button[ $num ]->configure( -foreground => 'yellow', -backgrou
+nd => 'red' );
    }
    $label[ $num ]->configure( -text => "Ping Success: $percent\% ($su
+ccess/$iterations) Avg. Time: $mean (High: $high, Low: $low)" );
}

sub PingSweep {
    $PingSweepLabel->configure( -text => "Starting PingSweep...." );
    $info = "Updating Ping Data......";
    for ( 1 .. $total ) {
        if ( $_ eq "" ) { last }
        Ping( $_ );
    }
    $info = $title . " -- Auto PingSweep every $seconds seconds";
    $now  = localtime();
    $PingSweepLabel->configure( -text => "Last PingSweep: $now" );
}

sub about {
    $mw->Dialog(
        -title => "About...",
        -text  => <<"END", -popover => $mw, -font => 'ansi' )->Show;
$title
Last Update: $update
    
       Author:    Kurt Kincaid
       Copyright (c) 2001, Kurt Kincaid
           All Rights Reserved
    
This is free software and may be modified and/or
redistributed under the sames terms as Perl itself.
END
}

sub help {
    my $helptext = HelpText();
    $helptext .= "\n" . HelpDetail();
    my $help_label = "$title Help";
    my $help       = MainWindow->new();
    $help->title( "Help" );
    my $mm = $help->Frame->pack( -side => 'top', -fill => 'x' );
    $mm->Button( -text => "Close Window", -command => sub { $help->des
+troy() } )
      ->pack( -side => 'right' );
    $help->Label( -textvariable => \$help_label, -relief => 'ridge' )
      ->pack( -side => 'bottom', -fill => 'x' );
    my $tt = $help->Scrolled("Text",
        -width      => 80,
        -wrap       => 'word',
        -background => '#ffff88',
        -font       => '{Courier} 8 {normal}',
        -scrollbars => 'e'
      )->pack(
        -side   => 'bottom',
        -fill   => 'both',
        -expand => 1
    );
    $tt->insert( "end", $helptext );
}

sub HelpText {
    my $where;
    if ( $opt_h ) {
        $where = "type \"pingsweep --xml\"";
    } else {
        $where = "see below."
    }
    my $ht = "$title
Last Update: $update

Usage:  pingsweep [--email address] [--file host_file] [--help] [--noe
+mail]
                  [--pings num_of_pings] [--recur seconds] [--version]
+ 
  --email   Specify an email address to which warnings should be
            emailed. The default address is: $address
            Multiple addresses should be separated by commas.
  --file    Specify alternate XML file with host information. The
            default is \"hostdata.xml,\" assumed to be stored in the
            same directory as pingsweep. When specifying another file,
+ the
            location must be in UNIX format (i.e. /some/dir/hosts.xml)
            For XML file specifications, $where
  --help    This help text.
  --noemail Do not send warning email, regardless of server failures.
            This supercedes all other email settings.
  --pings   The number of pings per host. The default is 20.
  --recur   Frequency of the auto pingsweep, in seconds. Default: 90 s
+econds.
  --version Prints the version number and exits.

Example: pingsweep --file somefile.xml --pings 10 --recur 300
NOTE:    You may use equal signs (=) when passing command line paramet
+ers,
         if preferred. (ex. pingsweep --file=somefile.xml)
";
    return $ht;
}

sub HelpDetail {
    my $dt = "XML Format Information
    The host file must follow standard XML rules and must be in
    the following format:
    <hosts>
        <host>
            <hostname>some_hostname</hostname>
            <ip_address>255.255.255.1</ip_address>
        </host>
        <host>
            <hostname>some_other_hostname</hostname>
            <ip_address>255.255.255.2</ip_address>
        </host>
        ...
    </hosts>
    PingSweep supports an arbitrary number of hosts. 
";
    return $dt;
}