#!/usr/bin/perl

#(c)2007-2009 Hurricane Labs
#Author: Billford
#License: See LICENSE file GPL v2
#Nagzilla Jabber Relay Bot Server

#import our required Perl modules
require Config::Simple;
require Data::Dumper;
require Log::LogLite;
use IO::Socket;
use IO::Socket::INET;
use IO::Select;
use Net::Jabber qw(Client);
use Net::Jabber qw(Message);
use Net::Jabber qw(Protocol);
use Net::Jabber qw(Presence);

$CONFDIR = "/etc/nagzillad";

# DO NOT EDIT ANYTHING BEYOND THIS POINT!!

$0.=''; # so that the init script is able to detect the process

##############Config File Setup#####################
Config::Simple->import_from('nagzillad.cfg', \%Config);
$cfg = new Config::Simple("$CONFDIR/nagzillad.cfg");

#Nagzillad Server Settings

$bindaddr = $cfg->param("BindAddr");
$bindport  = $cfg->param("BindPort");
$binduser = $cfg->param("BindUser");
$daemon = $cfg->param("Daemon");
$to_log = $cfg->param("To_Log");
$LOG_DIRECTORY = $cfg->param("Log_Directory");
$ERROR_LOG_LEVEL = $cfg->param("Error_Log_Level");

#Nagzillad Access Control
@allowedipaddr = $cfg->param("AllowedIPAddr");

#Jabber Server Settings

$jabberserver = $cfg->param("JabberServer");
$jabberport = $cfg->param("JabberPort");
$jabberdebug = $cfg->param("JabberDebug");
$jabbertls = $cfg->param("JabberTLS");
$jabberssl = $cfg->param("JabberSSL");
$jabbersasl = $cfg->param("JabberSASL");
$jabberuser = $cfg->param("JabberUser");
$jabberpass = $cfg->param("JabberPass");
$jabberresource = $cfg->param("JabberResource");
$jabbermaxwait = $cfg->param("JabberMaxWait");

#conference server settings

$confserver = $cfg->param("ConfServer");
@confrooms = $cfg->param("ConfRooms");
$confnick = $cfg->param("ConfNick");

@roominess = @confrooms;

###########End Config Setup#####################

my $log = new Log::LogLite( $LOG_DIRECTORY . "/nagzillad.log", $ERROR_LOG_LEVEL );

# make_access_checker - returns a function which checks if an IP address
# should be allowed to connect to this nagzillad. 
#
# It takes a reference to an an array of IP addresses (dotted quad strings).
#
# It returns a function which takes an IP address (also a dotted quad
# string). That function will return 1 if the IP address is allowed and
# undef if it isn't.
#
sub make_access_checker {
	my $ok_addrs = shift;
	my %ok_addr_set = map { $_ => 1 } @{$ok_addrs};
	return sub {
		my $addr = shift;
		return $ok_addr_set{$addr};
	}
}

my $check_access = make_access_checker(\@allowedipaddr);


#taken from a Perl tutorial somewhere a million years ago so direct reference escapes me.
sub daemonize {
	chdir '/' or die "Can't chdir to /: $!";
	open STDIN,  '/dev/null'   or die "Can't read /dev/null: $!";
	open STDOUT, '>>/dev/null' or die "Can't write to /dev/null: $!";
	open STDERR, '>>/dev/null' or die "Can't write to /dev/null: $!";
	defined( my $pid = fork ) or die "Can't fork: $!";

	#setsid - from McMaster's salvia;
	if( $pid != 0 ) {
		open( PIDFILE, '>/var/run/nagzillad.pid' );
		print PIDFILE "$pid\n";
		close(PIDFILE);
		chown $uid, 0, "/var/run/nagzillad.pid";
		chmod oct("0644"), "/var/run/nagzillad.pid";

		# Change user ID - automagically
		my $uid = ( getpwnam('nobody') )[2];
		$> = $uid;
		exit(0);
	}
	setsid or die "Can't start a new session: $!";
	umask 0;
}

if ($daemon eq 1) {
	&daemonize;

	# Change user ID - automagically
	my $uid = ( getpwnam('nobody') )[2];
	$> = $uid;
}

#Let's make us a socket
$local = IO::Socket::INET->new(
	Proto	 => 'tcp',
	LocalAddr => $bindaddr,
	LocalPort => $bindport,
	Reuse	 => 1
) or die "$!";
$local->listen();	#Tell our socket to listen
#This is on by default with newer versions of IO::Socket but for bc let's turn it on anyway
$local->autoflush(1); 

if ($to_log eq 1) {
	$log->write( "Nagzillad Server Started", 5 );
}

#Start Jabber Stuff

# Creates a new connection to the jabber server
my $connection = Net::Jabber::Client->new( debugLevel => $jabberdebug );
$connection->Connect(
	"hostname" => $jabberserver,
	"port"	 => $jabberport,
	"tls"	  => $jabbertls,
	"ssl"	  => $jabberssl
) or die "Cannot connect ($!)\n";	#Return an error on failure

my @result;
if ($jabbersasl) {
	@result = $connection->AuthSend(
		"username" => $jabberuser,
		"password" => $jabberpass,
		"resource" => $jabberresource
	);

} else {
	@result = $connection->AuthIQAuth(
		"username" => $jabberuser,
		"password" => $jabberpass,
		"resource" => $jabberresource
	);
}

if ($result[0] ne "ok") {
	#Send an auth request, return on failure
	die "Ident/Auth with server failed: $result[0] - $result[1]\n";	
}

#Allow the daemon to hang out in as many rooms as needed (defined in config file)
#Depending on your Jabber server setup specifying a non-existent room will create that room

foreach $confs (@confrooms) {
	my $room = $connection->MUCJoin(
		room   => "$confs",
		server => "$confserver",	#Conference server
		nick   => "$confnick"
	);							  #Join a room
}

$readable_handles = new IO::Select();
$readable_handles->add($local);

while (1) {
	($new_readable) = IO::Select->select( $readable_handles, undef, undef, undef );

	foreach $sock (@$new_readable) {
		if ($sock == $local) {
			$new_sock = $sock->accept();
			my $client_name = $new_sock->peeraddr;
			$ip = inet_ntoa($client_name);

			next if not defined $new_sock;
			
			# check if the new peer's IP address is permitted via
			# the AllowedIPAddr conf statement.
			if ($check_access->($ip)) {
				$log->write("accepted connection from $ip",1);
				$readable_handles->add($new_sock);
			} else {
				$log->write("rejected connection from $ip - not in AllowedIPAddr",5);
				close $new_sock;
			}
		} else {
			$buf = <$sock>;

			$readable_handles->remove($sock);
			close $sock;

			if ($buf) {

				my ( $style, $roomy, $mess ) = split( /\^/, $buf, 3 );

				my $message = Net::Jabber::Message->new();
				if ($style eq "room") {
					$message->SetMessage(
						"type" => 'groupchat',
						"to"   => $roomy =~ /@/ ? $roomy : "$roomy\@$confserver",
						"type" => 'chat',
						"body" => $mess
					);

				}
				else {
					$message->SetMessage(
						"to" => $roomy =~ /@/ ? $roomy: "$roomy\@$jabberserver",
						"subject" => "Monitoring Alert",
						"type"	=> 'chat',
						"body"	=> "$mess"
					);

				}

				# dirty hack to allow RawXML: message text starting off with ^<,
				# strip off the ^
				if ($mess =~ /^\^</) {
					$log->write("--RawXML-- $style for $roomy ", 10);
					$message->RemoveBody();
					$mess =~ s/^\^</</;
					$message->InsertRawXML($mess);
				}

				#Send message from STDIN -- probably should add some error handling
				#There is some bug in at least ejabberd that causes messages to
				#be sent "offline". They get flushed on nagzilla restart
				#I don't know of a good way to check if this is happening yet
				#More to come - BM
				$connection->Send($message); 

				if ($to_log eq 1) {
					$log->write( "--$mess-- sent to $roomy from $ip", 5 );

				}
			}
		}

	}
	#Creates a sleep timer so many messages can be handled without issue
	sleep(MAXWAIT);	
}

