Jesper Krogh's Jabber Transport mon script

#!/usr/bin/perl -w
#
# Copyright Jesper Krogh<jesper@krogh.cc>
# JabberID: jesper@jabbernet.dk
# This program may be distributed under the terms of 
# GPLv2 or better. 
# 
# Jabbertransport monitor plugin for mon 
# http://www.kernel.org/software/mon/
#
#The script works by logging into the server and sending a 
# IQ/GET jabber:iq:browse to the transport/server specified
#
# Sample mon.cf configuration piece. 
# ------- 
# hostgroup        yahoo                     yahoo.jabbernet.dk
# watch yahoo
#        service yahooservice
#                description test yahoo services
#                interval 2m
#                monitor jabbertransport.monitor -u<testbotusername> -p<testbotpassword> -h<jabberserver>
#                period wd {Mon-Sun}
#                        alert mail.alert root
#                        upalert mail.alert root
#                        alertevery 10m
#---------
#The Jabberaccount <testbotusername>@<jabberserver> must be created manually. 


use strict;

use Getopt::Std;
use Net::Jabber qw(Client);
use XML::Parser;
use vars qw($opt_h $opt_u $opt_p);

getopts('h:u:p:');

my $debug = 0;
my $runs = 1;

if(!($opt_h && $opt_u && $opt_p)){
	print "Error -u (username) -p (password) or -h (host) option is missing\n";
	exit 1;
}

my $client = Net::Jabber::Client->new(debuglevel => 0);


$client->SetCallBacks("iq" => \&handle_iq);

print "Connecting\n" if $debug;
$client->Connect('hostname' => $opt_h,
		'port' => 5222);
if(!$client->Connected()){
   print "Could not connect\n";
   exit 1;
}
print "Connected\n" if $debug;
print "Authenticating\n" if $debug;
$client->AuthSend('username' => $opt_u,
		'password' => $opt_p,
		'resource' => "testbot-$$");

print "Done authentification\n" if $debug;
my $parser = new XML::Parser;

my $tag = "";
my $code = "";
my $reason = "";
my $from = "";
my @failures = ();
my @details = ();

$parser->setHandlers(      
		Start => \&startElement,
		End => \&endElement,
		Char => \&characterData,
		Default => \&default);

my $TIMEOUT = 300;

eval {

	local $SIG{ALRM} = sub { die "Timeout Alarm" };
	alarm $TIMEOUT;


	foreach my $host(@ARGV){
		for(my $i = 0; $i<$runs; $i++){
			my $iq = new Net::Jabber::IQ();
			$iq->SetIQ(to => $host, type => "get");
			$iq->NewQuery("jabber:iq:browse");
			print "Sending\n" if $debug;
			$client->Send($iq);
			print "Procession\n" if $debug;
			$client->Process();
			print "End\n" if $debug;
		}
	}
	alarm 0;

};

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


print join (" ", sort @failures), "\n";

my $msg;
foreach $msg (@details)
{
	print "$msg\n";
}

exit 1;


sub handle_iq{

	my ($sid,$iq) = @_;
#	print $iq->GetFrom() . "\n" if $iq->GetType() eq "error";
#	print $iq->GetXML() . "\n" if $iq->GetType() eq "error";
	$parser->parse($iq->GetXML());

}
sub characterData {
	my( $parseinst, $data ) = @_;
	if (($tag eq "error")) {
		$reason = $data;
	}
}

sub startElement {
	my( $parseinst, $element, %attrs ) = @_;
	if ($element eq "error") {
		$tag = "error";
		$reason = "";
		$code = $attrs{'code'}
	}elsif($element eq "iq"){
		$from = $attrs{'from'}
	}	
}

sub endElement {
	my( $parseinst, $element ) = @_;
	if ($element eq "error") {
		push (@failures,$from);
		push (@details,$code . " " . $reason);
	}
}

sub default {
	my( $parseinst, $data ) = @_;
# you could do something here
}