#!/usr/bin/perl -wT

# -----------------------------------------------------------------------------
# File Name:		check_ircd.pl
#
# Author:		Richard Mayhew - South Africa
#
# Date:			1999/09/20
#
# $Id: check_ircd.pl,v 1.3 2002/05/07 05:35:49 sghosh Exp $
#
# Description:		This script will check to see if an IRCD is running
#			about how many users it has
#
# Email:		netsaint@splash.co.za
#
# -----------------------------------------------------------------------------
# Copyright 1999 (c) Richard Mayhew
#
# Credits go to Ethan Galstad for coding Nagios
#
# If any changes are made to this script, please mail me a copy of the
# changes :)
#
# Some code taken from Charlie Cook (check_disk.pl)
#
# License GPL
#
# -----------------------------------------------------------------------------
# Date		Author		Reason
# ----		------		------
#
# 1999/09/20	RM		Creation
#
# 1999/09/20	TP		Changed script to use strict, more secure by
#				specifying $ENV variables. The bind command is
#				still insecure through.  Did most of my work
#				with perl -wT and 'use strict'
#
# test using check_ircd.pl (irc-2.mit.edu|irc.erols.com|irc.core.com)
# 2002/05/02    SG		Fixed for Embedded Perl
#

# ----------------------------------------------------------------[ Require ]--

require 5.004;

# -------------------------------------------------------------------[ Uses ]--

use strict;
use lib utils.pm;
use Plugin;
use Plugin::Parameter qw(:DEFAULT :standard $p_opt);

use Socket;

use vars qw($opt_V $opt_h $opt_t $opt_p $opt_H $opt_w $opt_c $opt_v);
use vars qw($PROGNAME);

use utils qw(%ERRORS &usage);

# ----------------------------------------------------[ Function Prototypes ]--

sub connection ($$$$);
sub bindRemote ($$$);

# -------------------------------------------------------------[ Enviroment ]--

$ENV{PATH} = "";
$ENV{ENV} = "";
$ENV{BASH_ENV} = "";

# -----------------------------------------------------------------[ Global ]--

my $NICK="ircd$$";
my $USER_INFO="monitor localhost localhost : ";

$w_opt->default(50);
$c_opt->default(100);
$p_opt->default(6667);
my $plugin = new Plugin(-revision => '$Revision: 1.3 $',
			-copyright => "2000 Richard Mayhew/Karl DeBisschop, 2004 Howard Wilkinson <howard\@cohtech.com>",
			-shortcomment => "Perl Check IRCD plugin for Nagios",
			-parameterlists => [ [ @standardparameters, $p_opt ],
					     $h_opts, $V_opts ]);
	
# -------------------------------------------------------------[ connection ]--
sub connection ($$$$)
{
	my ($in_remotehost,$in_users,$in_warn,$in_crit) = @_;
	my $state;
	my $answer;

	print "connection(debug): users = $in_users\n" if $opt_v;
	$in_users =~ s/\ //g;
	
	if ($in_users >= 0) {

		if ($in_users > $in_crit) {
			$state = "CRITICAL";
			$answer = "Critical Number Of Clients Connected : $in_users (Limit = $in_crit)\n";

		} elsif ($in_users > $in_warn) {
			$state = "WARNING";
			$answer = "Warning Number Of Clients Connected : $in_users (Limit = $in_warn)\n";

		} else {
			$state = "OK";
			$answer = "IRCD ok - Current Local Users: $in_users\n";
		}

	} else {
		$state = "UNKNOWN";
		$answer = "Server $in_remotehost has less than 0 users! Something is Really WRONG!\n";
	}
	
	print ClientSocket "quit\n";
	print $answer;
	exit $ERRORS{$state};
}

# -------------------------------------------------------------[ bindRemote ]--

sub bindRemote ($$$)
{
	my ($in_remotehost, $in_remoteport, $in_hostname) = @_;
	my $proto = getprotobyname('tcp');
	my $sockaddr;
	my $this;
	my $thisaddr = gethostbyname($in_hostname);
	my $that;
	my ($name, $aliases,$type,$len,$thataddr) = gethostbyname($in_remotehost);
#	($name,$aliases,$type,$len,$thisaddr) = gethostbyname($in_hostname);

	if (!socket(ClientSocket,AF_INET, SOCK_STREAM, $proto)) {
	    print "IRCD UNKNOWN: Could not start socket ($!)\n";
	    exit $ERRORS{"UNKNOWN"};
	}
	$sockaddr = 'S n a4 x8';
	$this = pack($sockaddr, AF_INET, 0, $thisaddr);
	$that = pack($sockaddr, AF_INET, $in_remoteport, $thataddr);
	if (!bind(ClientSocket, $this)) {
	    print "IRCD UNKNOWN: Could not bind socket ($!)\n";
	    exit $ERRORS{"UNKNOWN"};
	}
	if (!connect(ClientSocket, $that)) { 
	    print "IRCD UNKNOWN: Could not connect socket ($!)\n";
	    exit $ERRORS{"UNKNOWN"};
	}
	select(ClientSocket); $| = 1; select(STDOUT);
	return \*ClientSocket;
}

# ===================================================================[ MAIN ]==

MAIN:
{
	my $hostname;

	$plugin->init();

	$plugin->start_timeout($opt_t,
			       "Somthing is Taking a Long Time, Increase Your TIMEOUT (Currently Set At $opt_t Seconds)");

	chomp($hostname = `/bin/hostname`);
	$hostname = $1 if ($hostname =~ /([-.a-zA-Z0-9]+)/);
	my ($name, $alias, $proto) = getprotobyname('tcp');
	print "MAIN(debug): hostname = $hostname\n" if $opt_v;

	print "MAIN(debug): binding to remote host: $opt_H -> $opt_p -> $hostname\n" if $opt_v;
	my $ClientSocket = &bindRemote($opt_H,$opt_p,$hostname);
	
	print ClientSocket "NICK $NICK\nUSER $USER_INFO\n";
	
	while (<ClientSocket>) {
		print "MAIN(debug): default var = $_\n" if $opt_v;

		# DALnet,LagNet,UnderNet etc. Require this!
		# Replies with a PONG when presented with a PING query.
		# If a server doesn't require it, it will be ignored.
	
		if (m/^PING (.*)/) {print ClientSocket "PONG $1\n";}
	
		$plugin->stop_timeout();
	
		# Look for pattern in IRCD Output to gather Client Connections total.
		connection($opt_H,$1,$opt_w,$opt_c) if (m/:I have\s+(\d+)/);
	}
	print "IRCD UNKNOWN: Unknown error - maybe could not authenticate\n";
	exit $ERRORS{"UNKNOWN"};
}