#!/usr/bin/perl

$pingtype = 'icmp';

if ($pingtype eq 'icmp')
{
    if ($<)
    {
	print STDERR "ERROR: Pong Server must be run as 'root' to use ICMP pings.\n";
	exit 666;
    }
}

# Let's get our package requirements out of the way.

use LWP;
use Socket;  
use Net::Ping;
use Net::DNS;
use Net::Telnet;
require HTTP::Request;
require LWP::UserAgent;

$t = new Net::Telnet (Errmode=>'return', Timeout => 30);
$f_tel_obj = new Net::Telnet (Errmode => 'return', Timeout => 30, Port => 79);

$SIG{'HUP'} = 'reload_conf';

$script_name = $0;
($directory) = $script_name =~ /^(.*?)pong3server.pl$/;

require "${directory}pong3.conf";

while (1)
{
    foreach $host (sort(keys(%services)))
    {
	@services = split / /,$services{$host};
	
	foreach $service (@services)
	{
	    if ($service eq 'clientv')
	    {
		$f_tel_obj->open(Host=>$host);
		$error = $f_tel_obj->errmsg();
		if ($error)
		{
		    set_status ($host, 'clientv','red',$error);
		}
		else
		{
		    $f_tel_obj->print("clientv");
		    $foo = $f_tel_obj->getline(Timeout=>15);
		    $error = $f_tel_obj->errmsg();
		    if ($error)
		    {
			set_status ($host, 'clientv', 'red', $error);
		    }
		    else
		    {
			if ($foo)
			{
			    chomp $foo;
			    set_status($host,'clientv','green',$foo);
			}
			else
			{
			    set_status($host,'clientv','green',"<0.83");
			}
			chomp $foo;
		    }
		}
		$f_tel_obj -> close();
	    }

	    if ($service eq 'client')
	    {
		$f_tel_obj->open($host);
		$error = $f_tel_obj->errmsg();
		if ($error)
		{
		    set_status ($host, 'df','red',$error);
		    set_status ($host, 'load','red',$error);
# COMMENTED OUT UNTIL THE PLATFORM INDEPENDENT FREE CODE WORKS
#		    set_status ($host, 'free','red',$error);
		    set_status ($host, 'idle','red',$error);
		    $f_tel_obj -> close();
		}
		else
		{
		    $f_tel_obj->print("pong3");
		    $df = $f_tel_obj->getline(Timeout=>15);
		    chomp $df;
		    if (!$f_tel_obj->errmsg())
		    {
			$free = $f_tel_obj->getline(Timeout=>15);
			chomp $free;
			if (!$f_tel_obj->errmsg())
			{
			    $load = $f_tel_obj->getline(Timeout=>15);
			    chomp $load;
			    if (!$f_tel_obj->errmsg())
			    {
				$idle = $f_tel_obj->getline(Timeout=>15);
				chomp $idle;
			    }
			}
		    }
		    $error = $f_tel_obj->errmsg();

		    $f_tel_obj -> close();

		    $df_color = 'green';
		    if ($df =~ /^\d+[\r\n]?$/)
		    {
			if ( $df > $drive_yellow)
			{
			    $df_color = 'yellow';
			    if ($df > $drive_red)
			    {
				$df_color='red';
			    }
			}
		    }
		    else
		    {
		      $df_color='red';
		    }
		
		    $free_color = 'green';
		    if ($free =~ /^\d+[\r\n]?$/)
		    {
			if ($free < $free_yellow)
			{
			    $free_color = 'yellow';
			    if ($free < $free_red)
			    {
				$free_color = 'red';
			    }
			}
		    }
		    else
		    {
		      $free_color = 'red';
		    }
		
		    $load_color = 'green';
		    if ($load ne '')
		    {
			if ($load > $load_yellow)
			{
			    $load_color = 'yellow';
			    if ($load > $load_red)
			    {
				$load_color='red';
			    }
			}
		    }
		    else
		    {
		      $load_color='red';
		    }

		    $idle_color = 'green';
		    if ($idle ne '')
		    {
			if ($idle < $idle_yellow)
			{
			    $idle_color = 'yellow';
			    if ($idle < $idle_red)
			    {
				$idle_color = 'red';
			    }
			}
		    }

# Commented out 13 Jan 1998 to prevent free status files from 
# clogging system until we get that hammered out.
#
#		    set_status($host,'free',$free_color,$free);

		    set_status($host,'df',$df_color,$df);
		    set_status($host,'load',$load_color,$load);
		    set_status($host,'idle',$idle_color,$idle);
	        } # this now closes the above else
	    }

	    if ($service eq 'ping')
	    {
		$p = Net::Ping->new($pingtype);
		if ( $p->ping($host,4))
		{
		    $color = 'green';
		    $summary = "$host is alive.";
		}
		else
		{
		    sleep 5;
		    if ( $p->ping($host,4))
		    {
			$color='green';
			$summary = "$host is alive.";
		    }
		    else
		    {
			$color = 'red';
			$summary = "$host did not respond.";
		    }
		}
		set_status($host,$service,$color,$summary);
		$p->close(); 
	    }

	    if ($service eq 'dns')
	    {
		($color,$summary) = check_dns($host);
		set_status($host,$service,$color,$summary);
	    }

	    if ($service eq 'smtp')
	    {
		($color,$summary) = 
		    check_service($host,25,"","^\s*220",$service);
		set_status($host,$service,$color,$summary);
	    }

	    if ($service eq 'pop3')
	    {
		($color,$summary) = 
		    check_service($host,110,"","OK",$service);
		set_status($host,$service,$color,$summary);
	    }

	    if ($service eq 'ssh')
	    {
		($color,$summary) = 
		    check_service($host,22,"","SSH",$service);
		set_status($host,$service,$color,$summary);
	    }

	    if ($service eq 'nntp')
	    {
		($color,$summary) = 
		    check_service($host,119,"","200",$service);
		set_status($host,$service,$color,$summary);
	    }

	    if ($service eq 'imap')
	    {
		($color,$summary) = 
		    check_service($host,143,"","OK",$service);
		set_status($host,$service,$color,$summary);
	    }

	    if ($service eq 'telnet')
	    {
		($color,$summary) = check_telnet($host);
		set_status($host,$service,$color,$summary);
	    }

	    if ($service eq 'ftp')
	    {
		($color,$summary) = 
		    check_service($host,21,"","220",$service);
		set_status($host,$service,$color,$summary);
	    }

	    if ($service eq 'proxy')
	    {
		$proxy_port = $proxy_port{$host};
		($color,$summary) = (check_proxy ($host, $proxy_port));
		set_status ($host,$service,$color,$summary);
	    }

	    if ($service eq 'http')
	    {
		if ($odd_http{$host}) 
		{
		    $look_for = $odd_http{$host};
		}
		else
		{
		    $look_for = '200';
		}
		my $message;
		my $color;
		$message =
		    check_tcp($host,80,"HEAD / HTTP/1.0\r\n\r\n" );
		if( $message =~ /HTTP\S+\s+(\d\d\d)\s.*$/m ) 
		{
		    my $code = $1;

		    if (( $code >= 500 ) and ($code ne $look_for))
		    {
			$color = "red"; 
			$summary = "error - $code";
		    } 
		    elsif(( $code >= 400 ) and ($code ne $look_for))
		    {
			if( $color ne "red" ) 
			{
			    $color = "yellow"; 
			    $summary = "warning - $code"; 
			}
		    } 
		    else 
		    {
			if ( $color ne "red" && $color ne "yellow" ) 
			{
			    $color = "green"; 
			    $summary = "ok - $code"; 
			}
		    }
		} 
		elsif ( $message !~ /HTTP/m ) 
		{
		    $color = "red"; 
		    $summary = "no response from http server";
		} 
		else 
		{
		    if( $color ne "red" ) 
		    {
			$color = "yellow"; 
			$summary = "can't determine status code";
		    }
		}

#		$tmessage = "->HEAD / HTTP/1.0\n$message\n";
		set_status ($host,$service,$color,$message);
	    }                                       
	}
    }
    sleep($server_sleep_time);
}
		    
	
sub check_tcp {
   my( $addr, $port, $data ) = @_;
   my( $iaddr, $paddr, $proto, $line, $ip );

   if( $addr =~ /^\s*((\d+\.){3}\d+)\s*$/ ) {
      $ip = $addr;
   } else {
      my( @addrs ) = (gethostbyname($addr))[4];
      my( $a, $b, $c, $d ) = unpack( 'C4', $addrs[0] );
      $ip = "$a.$b.$c.$d";
   }

   $iaddr = inet_aton( $ip )                    || return -1;
   $paddr = sockaddr_in( $port, $iaddr );
   $proto = getprotobyname( 'tcp' );

   # Set an alarm so that if we can't connect "immediately" it times out.
   # Poor man's exception handling in perl...

   $SIG{'ALRM'} = sub { die };
   alarm(20);

   eval <<'_EOM_';    
   socket( SOCK, PF_INET, SOCK_STREAM, $proto ) || return -2;
   connect( SOCK, $paddr )                      || return -3;
   select((select(SOCK), $| = 1)[0]);
   print SOCK "$data";
   recv( SOCK, $line, 256, 0 );  # just grab a chunk from the service.
   close( SOCK )                                || return -4;
_EOM_

   alarm(0);
   return $line;
}   


sub check_dns {
    my( $host ) = @_;
    my( $color, $summary, $message ) = ( "green", "", "" );

    my $resolver = new Net::DNS::Resolver;
    my $q = $resolver->search( $host, "A" );

    if ( defined $q && defined $q->answer && defined (($q->answer)[0]) ) 
    {
	$color = "green";
	$summary = "dns ok";
    } 
    else 
    {
	$color = "red";
	$summary = "can't resolve $host";      
    }
    
    return ($color,$summary);
} 

sub check_service {
   my( $host, $port, $send, $check, $service ) = @_;
   my( $color, $summary ) = ( "green", "" );

   my $start   = time();
   my $message = check_tcp( $host, $port, $send );
   my $diff    = time() - $start;

   if( $message !~ /$check/ ) { $color = "red"; }

   $summary = "$service down\n$message"                            if $color eq "red";
   $summary = "$service ok - $diff second response time\n$message" if $color eq "green";
   
   return ($color,$summary);
}  

sub check_proxy
{
    my ($host, $port) = @_;

    my $look_for;
    my $color;
    my $summary;

    my $request = HTTP::Request->new(GET => "http://www.yahoo.com/");
    my $ua = new LWP::UserAgent;
    $ua -> proxy ("http", "http://$host:$port/");
    my $response = $ua -> request($request);

    my $line = $response->status_line;
    if ($odd_http{$host})
    {
	$look_for = $odd_http{$host};
    }
    else
    {
	$look_for = 200;
    }
    ($code) = $line =~ /^(\d+)\s/;

    if (( $code >= 500 ) and ($code ne $look_for))
    {
	$color = "red"; 
	$summary = "error - $code";
    } 
    elsif(( $code >= 400 ) and ($code ne $look_for))
    {
	if( $color ne "red" ) 
	{
	    $color = "yellow"; 
	    $summary = "warning - $code"; 
	}
    } 
    else 
    {
	if ( $color ne "red" && $color ne "yellow" ) 
	{
	    $color = "green"; 
	    $summary = "ok - $code"; 
	}
    }
    return ($color,$summary)
}

sub check_telnet
{
    my ($host) = @_;

    $t -> open ($host);
    $error = $t->errmsg();
    $t -> close;

    if ($error)
    {
	$summary = $error;
	$color = 'red';
    }
    else
    {
	$summary='Telnet Successful';
	$color = 'green';
    }
    return ($color,$summary);
}

sub set_status
{
    my ($host,$service,$color,$summary) = @_;

    my $oldcolor;

    if (-f "$pongserverdir/status/$host-$service-red")
    {
	$oldcolor = 'red';
	unlink ("$pongserverdir/status/$host-$service-red");
    }

    if (-f "$pongserverdir/status/$host-$service-green")
    {
	$oldcolor = 'green';
	unlink ("$pongserverdir/status/$host-$service-green");
    }

    if (-f "$pongserverdir/status/$host-$service-yellow")
    {
	$oldcolor = 'yellow';
	unlink ("$pongserverdir/status/$host-$service-yellow");
    }

    open STATUS, "> $pongserverdir/status/$host-$service-$color";
    print STATUS "$summary\n";
    close STATUS;

    if ( ($color ne $oldcolor) )
    {
	if ($LOG_CHANGES)
	{
	    system ("$LOG_EXTERNAL_CMD $host $service $color \"$summary\"");
	}
	if ($color ne 'green')
	{
	    foreach $notify_address (@notify_addresses)
	    {
		open NOTIFY, "| /bin/mail -s \"$host ($color)\" $notify_address";
		print NOTIFY "$host has changed status from '$oldcolor' to '$color' for service $service\n";
		close NOTIFY;
	    }
	}
    }
    

}

sub reload_conf
{
    open FILE, "${directory}pong3.conf";
    while (<FILE>)
    {
	eval $_;
    }
    close FILE;
}

