#!/usr/bin/perl
#
# mon monitor to check for circuit up and measure RTT
#

#
# Jon Meek - 09-May-1998
#
# Requires Perl Modules "Time::HiRes" and "Statistics::Descriptive"
#
# 

#
# $Id: up_rtt.monitor,v 1.1 1998/11/30 00:52:20 trockij Exp $
#
#    Copyright (C) 1998, Jon Meek, meekj@ieee.org
#
#    This program is free software; you can redistribute it and/or modify
#    it under the terms of the GNU General Public License as published by
#    the Free Software Foundation; either version 2 of the License, or
#    (at your option) any later version.
#
#    This program is distributed in the hope that it will be useful,
#    but WITHOUT ANY WARRANTY; without even the implied warranty of
#    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#    GNU General Public License for more details.
#
#    You should have received a copy of the GNU General Public License
#    along with this program; if not, write to the Free Software
#    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
#
# mon confifg file watch entry:

#watch frame-relay
#	service up_rtt
#	interval 5m
#       monitor up_rtt.monitor -T 2 -l /my/log_directory/logs/wan/fr_rtt_YYYYMM.log
#       period wd {Sun-Sat}
#         alert mail.alert meekj
#         alertevery 1h

# A new log file will be created each month in the above example the files will
# be of the form fr_rtt_199810.log
# The YYYYMM format is the only date string possible in the current version

use Getopt::Std;
use Socket;
use IO::Socket;
use Time::HiRes qw( gettimeofday tv_interval );
use Statistics::Descriptive;

getopts ("dt:T:l:U:");

# -d  Debug mode
# -p
# -t n     Number of seconds to wait for a packet to be echoed back
# -T n     Alarm if the minimum measured RTT is greater than n seconds
# -l file  Log file name with optional YYYYMM part that will be transformed to current month
# -U num   Number of UDP packets to send

$TimeOut = $opt_t || 10;     # Timeout in seconds
$NUM_UDP_TRYS = $opt_U || 5; # Number of UDP packet to send

@Failures = ();

@Hosts = @ARGV; # Host names are left on the command line after Getopt

$GoodPackets = 0;

foreach $TargetHost (@Hosts) {

    $stat = Statistics::Descriptive::Full->new();

    $TimeOfDay = time;

    $ReturnedPackets = &UDPcheck($TargetHost); # Try UDP echo first

    if ($ReturnedPackets == 0) { # If the UDP ping failed, then try TCP
	($ReturnedPackets, $RTT) = &TCPcheck($TargetHost);

	$ResultString{$TargetHost} = sprintf "%d %s %0.3f T",
	$TimeOfDay, $TargetHost, $RTT;

	if ($opt_d) {
	    print "$ResultString{$TargetHost}\n";
	}

#	if ($ReturnedPackets == 0) { # We give up, the target is down
#	    push (@Failures, $TargetHost);
#	}

    } else {

	$min = $stat->min();
	$mean = $stat->mean();
	$max = $stat->max();
	$count = $stat->count();

	$ResultString{$TargetHost} = sprintf "%d %s %0.3f %0.3f %0.3f %d",
	$TimeOfDay, $TargetHost, $min, $mean, $max, $count;

	if ($opt_T) { # Check minimum RTT for alarm limit
	    if ($min > $opt_T) {
		push (@Failures, $TargetHost);
	    }
	}

	if ($opt_d) {
	    print "$ResultString{$TargetHost}\n";
	}
    }
}

# Write results to logfile, if -l

if ($opt_l) {

    $LogFile = $opt_l;
    ($sec,$min,$hour,$mday,$Month,$Year,$wday,$yday,$isdst) =
        localtime($TimeOfDay);
    $Month++;
    $Year += 1900;
    $YYYYMM = sprintf('%04d%02d', $Year, $Month);
    $LogFile =~ s/YYYYMM/$YYYYMM/; # Fill in current year and month

    open(LOG, ">>$LogFile") || warn "$0 Can't open logfile: $LogFile\n";
    foreach $host (sort keys %ResultString) {
	print LOG "$ResultString{$host}\n";
    }
    close LOG;
}

if (@Failures == 0) {
    exit 0;
}

print "@Failures\n";

foreach $host (sort @Failures) {
    print "$host: $ResultString{$host} ";
}
print "\n";

exit 1;

#
# Subroutines below
#

sub UDPcheck {
    my($TargetHost) = @_;
    my($DroppedPackets, $GoodPackets);

    $DroppedPackets = 0;
    $GoodPackets = 0;

    $S = new IO::Socket::INET (PeerAddr => $TargetHost,
			       PeerPort => 7,
			       Proto => 'udp',
			       );
    do {
	&LeaveError($TargetHost, "Can't open UDP socket to $TargetHost\n");
	return 0;
    } unless ($S);

    $TimeNow = time;

    for ($i = 1; $i <= $NUM_UDP_TRYS; $i++) {
	$Out = "UDP$i"; # Number the packets
#       $Out .= ' 'x52; # Make a 56+ byte packet
	$DataLength = length($Out);

	$t1 = [gettimeofday];
	$BytesSent = send($S, $Out, 0); # Send the data

	$SIG{ALRM} = \&ReadTimeOut;
	eval {
	    alarm($TimeOut);

#       MSG_WAITALL 0x40 /* Wait for complete recv or error */
	    $RecvRet = recv($S, $Echo, $DataLength, 64);

	    $t2 = [gettimeofday];
	    alarm(0);
	};

	if ($@ =~ /Read Timeout/) {
	    $DroppedPackets++;
	    if ($opt_d) {
		print " Dropped packet $i, waited $TimeOut s\n";
	    }
	} else {

	    $dt = tv_interval ($t1, $t2);
	    if ($Echo eq $Out) {
		$stat->add_data($dt);
		if ($opt_d) {
		    print "$i - $DataLength - $dt -$Echo-\n";
		}
		$GoodPackets++;
	    } else {
		if ($opt_d) {
		    print "$i - $DataLength - $dt Bad Packet\n";
		}
	    }

	}
    }
    $S->close();
    return $GoodPackets;
}

sub TCPcheck {

    my($TargetHost) = @_;
    my($DroppedPackets, $GoodPackets, $dt);

    $S = new IO::Socket::INET (PeerAddr => $TargetHost,
			       PeerPort => 7,
			       Proto => 'tcp',
			       );
    do {
	&LeaveError($TargetHost, "Can't open TCP socket to $TargetHost\n");
	return 0;
    } unless ($S);

    $GoodPackets = 0;
    $i = 1;
    $dt = -1; # Will report -1 on failure
    $Out = "TCP$i";
    $DataLength = length($Out);

    $t1 = [gettimeofday];
    $BytesSent = send($S, $Out, 0); # Send the data

    $SIG{ALRM} = \&ReadTimeOut;
    eval {
	alarm($TimeOut);

#       MSG_WAITALL 0x40 /* Wait for complete recv or error */
	$RecvRet = recv($S, $Echo, $DataLength, 64);

	$t2 = [gettimeofday];
	alarm(0);
    };

    if ($@ =~ /Read Timeout/) {
	$DroppedPackets++;
	if ($opt_d) {
	    print " No Echo from TCP packet $i, waited $TimeOut s\n";
	}
    } else {

	$dt = tv_interval ($t1, $t2);
	if ($Echo eq $Out) {
	    if ($opt_d) {
		print "TCP $i - $DataLength - $dt -$Echo-\n";
	    }
	    $GoodPackets++;
	} else {
	    if ($opt_d) {
		print "TCP $i - $DataLength - $dt Bad Packet\n";
	    }
	}
    }

    $S->close();
    return $GoodPackets, $dt;
}

sub LeaveError {
    my ($host, $reason) = @_;
    push (@Failures, $host);
#    $ResultString{$host} .= $reason;
#    push (@FailReasons, $reason);
#    print "$reason\n";

#    exit 1;

}

sub ReadTimeOut { # For alarm/timeout signal
    die 'Read Timeout';
}
