#!/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);

#Point me to your nagzillad.pl directory
$CONFDIR = "/etc/nagzillad";

# DO NOT EDIT ANYTHING BEYOND THIS POINT!!

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

$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 );

###########Function Setups#######################

# 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);

sub send_plain_chat {


 	our $message = Net::Jabber::Message->new();
        $message->SetMessage(
        "type" => $style,
        "to"   => $roomy =~ /@/ ? $roomy : "$roomy\@$confserver",
        "body" => $mess
	);

}#end send_plain_chat

sub send_color_chat {

	#make some pretty colors
if ($col eq "red"){
	$col = "\#ff0c00\;";
}elsif ($col eq "yellow"){
	$col = "\#fff00\;";
}elsif ($col eq "green"){
	$col = "\#00ff00\;";
}elsif ($col eq ""){
	$col = "\#000000\;";
};
 

 	our $message = Net::Jabber::Message->new();
	my $bod = "<body>hello</body><html xmlns='http://jabber.org/protocol/xhtml-im'><body xmlns='http://www.w3.org/1999/xhtml'><span style='font-family: Helvetica; font-size: medium; color: $col'>$mess</span></body></html>";

	$message->RemoveBody();
	$bod =~ s/^\^</</;

        $message->SetMessage(
        "type" => $style,
        "to"   => $roomy =~ /@/ ? $roomy : "$roomy\@$confserver"
	);
	$message->InsertRawXML($bod);

}#end send_color_chat

sub PresenceReceived
{
        my ($sid, $presence) = @_;

        my $from = $presence->GetFrom();
        my $type = $presence->GetType();

        return "" if ($type eq '');

        $log->write( "Received presence notification of type '$type' from '$from'", 5 );

        if ($type eq 'subscribe')
        {
                $connection->Subscription
                (
                        type => 'subscribed',
                        to => $from
                );
        }
        elsif ($type eq 'unsubscribe')
        {
                $connection->Subscription
                (
                        type => 'unsubscribed',
                        to => $from
                );
        }
        $connection->PresenceSend();
}#End PresenceReceived



##########End Function Setups###################

#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
our $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
	);
}

$connection->PresenceSend();

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
}

$connection->SetCallBacks
(
        presence => \&PresenceReceived
);


$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) {


				our ( $style, $roomy, $mess, $col ) = split( /\^/, $buf, 4 );

				 if ($style && $roomy && $mess) {
				send_color_chat( $style, $roomy, $mess, $col );

				$connection->Process();
				}


				}

				# 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);	
