#!/usr/bin/perl -W

#__________________________________________
#                                          |
#   |~|_        -- Funky Penguin --        |
#   o-o    Corporate GNU/Linux Solutions   |
#   /V\                                    |
#  // \\                                   |
# /(   )\  ..Work smarter, not harder..    |
#  ^-~-^     [www.funkypenguin.co.za]      |
###########################################|

# Bandersnatch - A jabber logger and statistics reporter
#
# Bandersnatch is an external Jabber (www.jabber.org) component that logs
# all messages sent to it into a DBI-compatible database. It has a rudimentary
# jabber interface. (Sending a jabber message to the component will ellicit your
# current stats).
#
# Bandersnatch's real usefulness is in it's PHP-based web frontend. From that
# interface it's possible to view remote vs. local usage, individual tranport
# usage, etc. FIXME

###############################################################################
#               Bandersnatch - Jabber logger and statistics reporter           #
#          Copyright (C) 2003, David Young <davidy@funkypenguin.co.za>        #
#                                                                             #
#  This program is free software; you can redistribute it and/or modify it    #
#  under the terms of the GNU General Public License as published by the Free #
#  Software Foundation; either version 2 of the License, or (at your option)  #
#  any later version.                                                         #
#                                                                             #
#  This program is distributed in the hope that it will be useful, but        #
#  WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY #
#  or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License   #
#  for more details.                                                          #
#                                                                             #
#  You should have received a copy of the GNU General Public License along    #
#  with this program; if not, write to the Free Software Foundation, Inc.,    #
# 	59 Temple Place, Suite 330, Boston, MA 02111-1307 USA                     #
#                                                                             #
###############################################################################

my $VERSION = "0.0.1";

# +----------------------------------------------------------------------------+
# | Declare Global Variables                                                   |
# +----------------------------------------------------------------------------+

my %config;
my $prevmessage = ""; # for catching duplicate messages
my @routes;
my $dbh;
my $timer;
my $status;


# Clean path whenever you use taint checks (Make %ENV safer)
$ENV{'PATH'} = "";
delete @ENV{qw(IFS CDPATH ENV BASH_ENV)};

# Set up vars
my $config_file = $ARGV[0];
my $configdir = ".";
my $config;

# Check user input
if(defined $config_file)
{
  # Untaint by stripping any bad characters, see "perlsec" man page.
  $config_file =~ /^([-\w.\/]+)$/ or die "Bad characters found\n\n";
  $config_file = $1;
}
else
{
  $config_file = "$configdir/config.xml";
}


# +----------------------------------------------------------------------------+
# | Load Modules                                                               |
# +----------------------------------------------------------------------------+
use strict;
use Net::Jabber 1.0024 qw(Component);
use XML::Stream qw(Tree);
use DBI;
use Getopt::Long;



# +----------------------------------------------------------------------------+
# | Load Command Line Arguments                                                |
# +----------------------------------------------------------------------------+

#my %optctl = ();
#$optctl{config}	= "/opt/jabberd/bandersnatch/config.xml";  #FIXME - remember to disable this
#&GetOptions(\%optctl, "config=s");



# +----------------------------------------------------------------------------+
# | Load Configuration                                                         |
# +----------------------------------------------------------------------------+

&loadConfig();



# +----------------------------------------------------------------------------+
# | Initialize Debug System                                                    |
# +----------------------------------------------------------------------------+

my $debug = new Net::Jabber::Debug( level  => $config{debug}->{level},
                                    header => "Bandersnatch",
                                    time   => 1,
                                    file   => $config{debug}->{file});



# +----------------------------------------------------------------------------+
# | Declare Signal Intercepts                                                  |
# +----------------------------------------------------------------------------+
# | Configure a subroutine to be called when a HUP, KILL, TERM, or INT signal  |
# | is received so that we may shut things down gracefully.                    |
# +----------------------------------------------------------------------------+

$SIG{HUP}	= \&Shutdown;
$SIG{KILL}	= \&Shutdown;
$SIG{TERM}	= \&Shutdown;
$SIG{INT}	= \&Shutdown;



# +----------------------------------------------------------------------------+
# | Create Component                                                           |
# +----------------------------------------------------------------------------+

my $component = new Net::Jabber::Component(debuglevel=>$config{debug}->{level});

$component->SetCallBacks(
        message		=> \&messageCB,
				presence	=> \&presenceCB,
				receive		=> \&receiveCB,
				iq		    => \&iqCB);



# +----------------------------------------------------------------------------+
# | Connect to Jabber Server                                                   |
# +----------------------------------------------------------------------------+

if (!connectJabber()) {
	$debug->Log0("(ERROR) Unable to connect to Jabber server ($config{server}->{hostname}) ...");
	$debug->Log0("        (".$component->GetErrorCode(),")");
	exit(0);
}

$debug->Log0("Connected to Jabber server ($config{server}->{hostname}) ...");



# +----------------------------------------------------------------------------+
# | Connect to Database Server                                                 |
# +----------------------------------------------------------------------------+

if (!connectDatabase())
{
	$debug->Log0("(ERROR) Unable to connect to MySQL database (".$config{mysql}->{server}."@".$config{mysql}->{server}.")");
	exit(0);
}

$debug->Log0("Connected to MySQL database (".$config{mysql}->{dbname}."@".$config{mysql}->{server}.") ...");


# +----------------------------------------------------------------------------+
# | Flush user table. We don't know how long we've been offline, so set all user
# | records to "offline"
# +----------------------------------------------------------------------------+
flush_user_table();


# +----------------------------------------------------------------------------+
# | Maintain Connection                                                        |
# +----------------------------------------------------------------------------+

my $connected = 1;

while ($connected == 1) {

	while ($status = $component->Process()) { }

    if (!defined($status)) {

        $connected = 0;

        $debug->Log0("Connection to Jabber server ($config{server}->{hostname}) has been lost ...");
    
        if ($config{server}->{connectiontype} eq "tcpip")
        {
            for my $count (1..20)
            {
                sleep(30);

                $debug->Log0("Attempting to reconnect (${count}/20) ...");

				if (connectJabber()) {
					$debug->Log0("Connection has been re-established ...");
					$connected = 1;
					last;
				}
				else
				{
					$debug->Log0("(ERROR) Unable to re-establish connection to Jabber Server ($config{server}->{hostname}) - ".$component->GetErrorCode());
				}
			}
			if ($connected == 0)
			{
				$debug->Log0("(ERROR) Unable to re-establish connection to Jabber server ($config{server}->{hostname}) - ".$component->GetErrorCode());
				exit(0);
			}
		}
	}
}

$debug->Log0("(ERROR) Exiting ...");

exit(0);



# +----------------------------------------------------------------------------+
# | Load Configuration Settings                                                |
# +----------------------------------------------------------------------------+
sub loadConfig
{

	my $parser = new XML::Stream::Parser(style=>"Tree");
	my @tree = $parser->parsefile($config_file);

	# +------------------------------------------------------------------------+
	# | Jabber Server Settings                                                 |
	# +------------------------------------------------------------------------+
	my @serverTree						         = &XML::Stream::GetXMLData("tree", $tree[0], "server", "", "");
	$config{server}->{hostname}	       = &XML::Stream::GetXMLData("value", \@serverTree, "hostname", "", "");
	$config{server}->{port}			       = &XML::Stream::GetXMLData("value", \@serverTree, "port", "", "");
	$config{server}->{secret}			     = &XML::Stream::GetXMLData("value", \@serverTree, "secret", "", "");
	$config{server}->{connectiontype}	 = &XML::Stream::GetXMLData("value", \@serverTree, "connectiontype", "", "");
	$config{server}->{connectiontype}	 = "tcpip" if ($config{server}->{connectiontype} eq "");

	# +------------------------------------------------------------------------+
	# | Component Settings                                                     |
	# +------------------------------------------------------------------------+
	my @componentTree				        	= &XML::Stream::GetXMLData("tree", $tree[0], "component", "", "");
	$config{component}->{name}			  = &XML::Stream::GetXMLData("value", \@componentTree, "name", "", "");

	# +------------------------------------------------------------------------+
	# | Database Settings                                                      |
	# +------------------------------------------------------------------------+
	my @mysqlTree					            = &XML::Stream::GetXMLData("tree", $tree[0], "mysql", "", "");
	$config{mysql}->{server}			    = &XML::Stream::GetXMLData("value", \@mysqlTree, "server", "", "");
	$config{mysql}->{dbname}			    = &XML::Stream::GetXMLData("value", \@mysqlTree, "dbname", "", "");
	$config{mysql}->{username}			  = &XML::Stream::GetXMLData("value", \@mysqlTree, "username", "", "");
	$config{mysql}->{password}			  = &XML::Stream::GetXMLData("value", \@mysqlTree, "password", "", "");

	# +------------------------------------------------------------------------+
	# | Debug Settings                                                         |
	# +------------------------------------------------------------------------+
	my @debugTree						          = &XML::Stream::GetXMLData("tree", $tree[0], "debug", "", "");
	$config{debug}->{level}				    = &XML::Stream::GetXMLData("value", \@debugTree, "level", "", "");
	$config{debug}->{file}				    = &XML::Stream::GetXMLData("value", \@debugTree, "file", "", "");

	# +------------------------------------------------------------------------+
	# | Site Settings                                                         |
	# +------------------------------------------------------------------------+
	my @siteTree						          = &XML::Stream::GetXMLData("tree", $tree[0], "site", "", "");
	$config{site}->{local_server}	    = &XML::Stream::GetXMLData("value", \@siteTree, "local_server", "", "");
  $config{site}->{privacy}			    = &XML::Stream::GetXMLData("value", \@siteTree, "privacy", "", "");
  $config{site}->{aggressive_presence} = &XML::Stream::GetXMLData("value", \@siteTree, "aggressive_presence", "", "");
	my @admin_jids					          = &XML::Stream::GetXMLData("value array", \@siteTree, "admin_jids", "", "");
	$config{site}->{admin_jids}		    = \@admin_jids;
	my @confidential_jids					    = &XML::Stream::GetXMLData("value array", \@siteTree, "confidential_jids", "", "");
	$config{site}->{confidential_jids} = \@confidential_jids;
	my @ignore_jids 					        = &XML::Stream::GetXMLData("value array", \@siteTree, "ignore_jids", "", "");
	my @local_domains 					        = &XML::Stream::GetXMLData("value array", \@siteTree, "local_domains", "", "");

  
  ##################################
  # check that local_domains contains the value of local_server. If not, put it in :)
  ################################
  my $local_server = $config{site}->{local_server};
  my $found_in_array;
  foreach my $domain (@local_domains) {
		if ($domain =~ /^$local_server/) {
      $found_in_array = 1;
		}
  }
  if (!$found_in_array) {
    push(@local_domains,$local_server);
  }
  $config{site}{local_domains}			= \@local_domains;

  ##################################
  # check that ignore_jids contains the name of component. If not, put it in :)
  ################################
  my $component_name = $config{component}->{name};
  $found_in_array = 0;
  foreach my $jid (@ignore_jids) {
		if ($jid =~ /^$component_name/) {
      $found_in_array = 1;
		}
  }
  if (!$found_in_array) {
    push(@ignore_jids,$component_name);
  }
  $config{site}{ignore_jids}			    = \@ignore_jids;
  $parser->{HANDLER}->{startDocument} = undef;
  $parser->{HANDLER}->{endDocument}   = undef;
  $parser->{HANDLER}->{startElement}  = undef;
  $parser->{HANDLER}->{endElement}    = undef;
  $parser->{HANDLER}->{characters}    = undef;
}


  
  

# +----------------------------------------------------------------------------+
# | Parse <route> XML data                                                |
# +----------------------------------------------------------------------------+
sub parseroute
{

	my $rawxml = shift;
	my %message;
	my $parser = new XML::Stream::Parser(style=>"Tree");

	my @tree = $parser->parse($rawxml);

	# +------------------------------------------------------------------------+
	# | Message encapsulated in <route> envelope (http://www.jabber.org/protocol/coredata.html)                                                 |
	# +------------------------------------------------------------------------+
	my @messageTree						= &XML::Stream::GetXMLData("tree", $tree[0], "message", "", "");
	
	$message{'to'}  					= &XML::Stream::GetXMLData("value", \@messageTree, "", "to", "");
	$message{'from'}					= &XML::Stream::GetXMLData("value", \@messageTree, "", "from", "");
	$message{'id'}						= &XML::Stream::GetXMLData("value", \@messageTree, "", "id", "");
	$message{'type'}					= &XML::Stream::GetXMLData("value", \@messageTree, "", "type", "");
	
	$message{'body'}					= &XML::Stream::GetXMLData("value", \@messageTree, "body", "", "");		
	$message{'subject'}				= &XML::Stream::GetXMLData("value", \@messageTree, "subject", "", "");			
	$message{'thread'}				= &XML::Stream::GetXMLData("value", \@messageTree, "thread", "", "");			
	
	$message{'error'}					= &XML::Stream::GetXMLData("value", \@messageTree, "error", "", "");		
	$message{'errorcode'}			= &XML::Stream::GetXMLData("value", \@messageTree, "error", "code", "");
	
   $parser->{HANDLER}->{startDocument} = undef;
   $parser->{HANDLER}->{endDocument}   = undef;
   $parser->{HANDLER}->{startElement}  = undef;
   $parser->{HANDLER}->{endElement}    = undef;
   $parser->{HANDLER}->{characters}    = undef;
       return %message;

	
}

# +----------------------------------------------------------------------------+
# | Set all users to offline, only called on startup!
# +----------------------------------------------------------------------------+
sub flush_user_table
{
	my $sqlquery = ("UPDATE user SET user_status = 'offline'");
	my $sth = $dbh->prepare($sqlquery);
	$sth->execute;
	$debug->Log1("Startup: Setting all users to offline in user table");

}


#__________________________________________
#                                          |
#   |~|_        -- Funky Penguin --        |
#   o-o    Corporate GNU/Linux Solutions   |
#   /V\                                    |
#  // \\                                   |
# /(   )\  ..Work smarter, not harder..    |
#  ^-~-^     [www.funkypenguin.co.za]      |
###########################################|
# Function   : determine_presence
# Purpose    : Given type, status, and show, return the "real" presence.
# Parameters : string $type   -> The presence type atribute. Default jabber online type is often blank
#              string $status -> The presence status attribute. More descriptive, but often also blank
#              string $show   -> The presence show attribute. Set by the client, so never 100% reliable
##########################################*/
sub determine_presence {

	my $type 	= shift;
	my $status 	= shift;
	my $show 	= shift;
	
if (($type =~ /subscribe$/) || ($type eq "probe")) { 
	return "online"; 
} # Mark subscribe / unsub requests as "online"

if ((($type eq "unavailable") && (!$status)) || ($status eq "Invisible")) {
			return "invisible"; 
		} elsif ((!$type) && (!$show)) {
			return "online";
		} elsif (($type eq "unavailable") && ($status)) {
			return "offline"; 			
		} else {
			return $show;
		}
}

#__________________________________________
#                                          |
#   |~|_        -- Funky Penguin --        |
#   o-o    Corporate GNU/Linux Solutions   |
#   /V\                                    |
#  // \\                                   |
# /(   )\  ..Work smarter, not harder..    |
#  ^-~-^     [www.funkypenguin.co.za]      |
###########################################|
# Function   : receiveCB
# Purpose    : Function for the "receive-type" callback. Receives everything in raw XML
# Notes      : Jabber sends data to bandersnatch encased in <route> tags, so Net::Jabber can't
#              readily parse it into an object. So we parse it ourselves.
##########################################*/
sub receiveCB
{
	my $sid		  = shift;
	my $xmldata	= shift;
	my %message	= parseroute($xmldata);
	my $sqlquery;
  my $is_local = 0;
	
	return if (!$message{'body'}); # Don't log empty messages, or "non-<message>" messages :)
	
	# Avoid getting "double messages". Rather not modify mod_log.c
	my $currentmessage = $message{'to'}.$message{'from'}.$message{'thread'}.$message{'body'}.$message{'error'};
	return if ($currentmessage eq $prevmessage);
	$prevmessage = $currentmessage;	
	
	# Ignorable JIDs. (Certain "noisy" chatbot services come to mind!)
	foreach my $ignoreable_jid (@{$config{site}{ignore_jids}}) {
		if (($message{'to'} =~ /$ignoreable_jid/) || ($message{'from'} =~ /$ignoreable_jid/)) {
			$debug->Log1("receiveCB: ignoring ($ignoreable_jid)");
			return;
		}
  }
    
  ############# Mask confidential messages ########################
  my $to_local;
  my $from_local;
  foreach my $confidential_jid (@{$config{site}{confidential_jids}}) {
      $to_local = $confidential_jid if ($message{'to'} =~ /$confidential_jid/);
      $from_local = $confidential_jid if ($message{'from'} =~ /$confidential_jid/);
  }
  if (($to_local) && ($from_local)) {
    $message{'body'} = "Confidential ($from_local --> $to_local)";
  }
    
  ############# Mask depending on privacy level ########################
  $to_local = "";
  $from_local = "";
  if ($config{site}{privacy} == 3) {
    foreach my $local_domain (@{$config{site}{local_domains}}) {
      $to_local = $1 if ($message{'to'} =~ /([^@]+)\@$local_domain/);
      $from_local = $1 if ($message{'from'} =~ /([^@]+)\@$local_domain/);
    }
    $message{'to'} =~ s/([^@]+)(\@.*)/privacy-level-3$2/ if (!$to_local);
    $message{'from'} =~ s/([^@]+)(\@.*)/privacy-level-3$2/ if (!$from_local);
    $message{'body'} = "privacy-level-3";
  } elsif ($config{site}{privacy} == 2) {
    foreach my $local_domain (@{$config{site}{local_domains}}) {
      $to_local = $1 if ($message{'to'} =~ /([^@]+)\@$local_domain/);
      $from_local = $1 if ($message{'from'} =~ /([^@]+)\@$local_domain/);
    }
    $message{'to'} =~ s/([^@]+)(\@.*)/privacy-level-2$2/ if (!$to_local);
    $message{'from'} =~ s/([^@]+)(\@.*)/privacy-level-2$2/ if (!$from_local);
    $message{'body'} = "privacy-level-2" if ((!$from_local) || (!$to_local));
  } elsif ($config{site}{privacy} == 1) {
    foreach my $local_domain (@{$config{site}{local_domains}}) {
      $to_local = $1 if ($message{'to'} =~ /([^@]+)\@$local_domain/);
      $from_local = $1 if ($message{'from'} =~ /([^@]+)\@$local_domain/);
    }
    $message{'to'} =~ s/([^@]+)(\@.*)/privacy-level-1$2/ if (!$to_local);
    $message{'from'} =~ s/([^@]+)(\@.*)/privacy-level-1$2/ if (!$from_local);
  }
   ############# End Mask depending on privacy level ########################

	# Quote-ify all the variables we're going to be sticking into the database
	$message{'to'}	 	  	= $dbh->quote($message{'to'});
	$message{'from'}	  	= $dbh->quote($message{'from'});
	$message{'id'}	 	  	= $dbh->quote($message{'id'});
	$message{'type'} 	   	= $dbh->quote($message{'type'});
	$message{'body'} 	   	= $dbh->quote($message{'body'});
	$message{'subject'}	  = $dbh->quote($message{'subject'});
	$message{'thread'}	  = $dbh->quote($message{'thread'});
	$message{'error'}		  = $dbh->quote($message{'error'});
	$message{'errorcode'}	= $dbh->quote($message{'errorcode'});		

	$sqlquery = "INSERT INTO message (message_to,message_from,message_id,";
	$sqlquery .= "message_type,message_body,message_subject,message_thread,";
	$sqlquery .= "message_error,message_errorcode) VALUES (";
	$sqlquery .= $message{'to'}. ",";
	$sqlquery .= $message{'from'}. ",";
	$sqlquery .= $message{'id'}. ",";
	$sqlquery .= $message{'type'}. ",";
	$sqlquery .= $message{'body'}. ",";
	$sqlquery .= $message{'subject'}. ",";
	$sqlquery .= $message{'thread'}. ",";
	$sqlquery .= $message{'error'}. ",";
	$sqlquery .= $message{'errorcode'}. ")";
	
	$debug->Log2("receiveCB: query($sqlquery)");
	
 	my $sth = $dbh->prepare($sqlquery);
 	$sth->execute;
		

	#Update the activity on the users table, if it's SENT by a user on the local SERVER
	my $fromjid;

	if ($message{'from'} =~ /([a-z.]+\@$config{site}->{local_server})\//i ) {
		$fromjid = $1;
		$sth = $dbh->prepare("SELECT user_status, user_subscribed FROM user WHERE (user_jid = '$fromjid')");
		$sth->execute;
		my ($user_status,$subscribed) = $sth->fetchrow_array();
		if (($user_status) && ($user_status eq "offline"))
		{
			$dbh->do("UPDATE user SET user_status = 'online', user_lastactive = now() WHERE user_jid = '$fromjid'");
		}
		elsif ($user_status) {
			$dbh->do("UPDATE user SET user_lastactive = now() WHERE user_jid = '$fromjid'");
		} 
		

    if ($config{site}{aggressive_presence} eq "1") {
  		if ($subscribed eq "Y") {
		  	$debug->Log1("Aggressive Presence: $fromjid is subscribed, sending online presence");
			  $component->PresenceSend(to=>$fromjid, from=>$config{component}->{name}, type=>"online");
		  } else {
			  $debug->Log1("Aggressive Presence: $fromjid is not subscribed, sending subscribe request");
			  $component->PresenceSend(to=>$fromjid, type=>"subscribe", from=>$config{component}->{name});
		  }
    }
	}


}


#__________________________________________
#                                          |
#   |~|_        -- Funky Penguin --        |
#   o-o    Corporate GNU/Linux Solutions   |
#   /V\                                    |
#  // \\                                   |
# /(   )\  ..Work smarter, not harder..    |
#  ^-~-^     [www.funkypenguin.co.za]      |
###########################################|
# Function   : createstats
# Purpose    : Creates basic sent-recieve stats for delivery via jabber reply
# Parameters : string $jid -> The JID for whom to create stats
# Notes      : This function calls three "generate_" functions to do the work
##########################################*/
sub create_stats
{
	my $from = shift;
	my $message;
  
	$message = "\nJabber usage summary for \"$from\"\n\n";
	$message .= generate_message_summary($from,"now()");
 	#$message .= generate_presence_history($from);
	$message .= generate_top_list($from,"now()",5);
	$message .= "\n\nRegards,\nBandersnatch\n:dinosaur:";
	
}			

#__________________________________________
#                                          |
#   |~|_        -- Funky Penguin --        |
#   o-o    Corporate GNU/Linux Solutions   |
#   /V\                                    |
#  // \\                                   |
# /(   )\  ..Work smarter, not harder..    |
#  ^-~-^     [www.funkypenguin.co.za]      |
###########################################|
# Function   : createstatsadmin
# Purpose    : Creates basic sent-recieve stats for delivery via jabber reply
# Parameters : string $jid -> The JID for whom to create stats
# Notes      : This function calls three "generate_" functions to do the work
##########################################*/
sub create_stats_admin
{
	my $from = shift;
	my $message;

	$message = "\nJabber server statistics for \"".$config{site}->{local_server}. "\"\n\n";
#	$message .= generate_message_summary('',"now()");
#	$message .= generate_presence_history($from);
	$message .= generate_top_list('',"now()",20);
	$message .= "\n\nRegards,\nBandersnatch\n:dinosaur:";

}

#__________________________________________
#                                          |
#   |~|_        -- Funky Penguin --        |
#   o-o    Corporate GNU/Linux Solutions   |
#   /V\                                    |
#  // \\                                   |
# /(   )\  ..Work smarter, not harder..    |
#  ^-~-^     [www.funkypenguin.co.za]      |
###########################################|
# Function   : messageCB
# Purpose    : Function for message callback
# Parameters : string $sid        -> FIXME - what is this?
#              NJ Object $message -> The message, in a Net::Jabber object
# Notes      : This function is called when a message is sent DIRECTLY to
#              us, NOT as an intercept. i.e. - it was addressed to US.
#              FIXME - Ultimately, admin should get more stats, like users online, top users etc.
##########################################*/
sub messageCB
{
	my $sid	   	= shift;
	my $message	= shift;
	my $from	  = lc($message->GetFrom("jid")->GetJID());
	my $subject	= $message->GetSubject();
	my $body    = $message->GetBody();
	my $type	  = $message->GetType();
  my $is_admin = 0;
	my $jog_id;
	my $subscribed;
	
	$debug->Log1("messageCB: message(",$message->GetXML(),")");

	# Ignorable JIDs. (Certain "noisy" chatbot services come to mind!)
	foreach my $ignoreable_jid (@{$config{site}{ignore_jids}}) {
		if ($from =~ /$ignoreable_jid/) {
			$debug->Log2("messageCB: ignoring ($ignoreable_jid)");
			return;
		}
  }


  # Determine whether the sender is an admin
  foreach my $admin_jid (@{$config{site}{admin_jids}}) {
	 if ($from =~ /$admin_jid/) {
      $is_admin = 1;
   }
  }
  
	if ($is_admin == 1)
	{
		$component->MessageSend(to=>$from, from=>$config{component}->{name}, type=>$type, body=>&create_stats_admin($from));
	}
	else
	{
		$component->MessageSend(to=>$from, from=>$config{component}->{name}, type=>$type, body=>&create_stats($from));
	}
}



#__________________________________________
#                                          |
#   |~|_        -- Funky Penguin --        |
#   o-o    Corporate GNU/Linux Solutions   |
#   /V\                                    |
#  // \\                                   |
# /(   )\  ..Work smarter, not harder..    |
#  ^-~-^     [www.funkypenguin.co.za]      |
###########################################|
# Function   : presenceCB
# Purpose    : Function for presence callback
# Parameters : string $sid         -> FIXME - what is this?
#              NJ Object $presence -> The presence message, as a Net::Jabber object
# Notes      : This function is called when we receive a presence message. It
#              was either sent directly to us on purpose, or it was sent via
#              Jabber's <bcc> option.
##########################################*/
sub presenceCB
{

	my $sid			= shift;
	my $presence	= shift;
	my $sqlquery;
	
	my $type 		= $presence->GetType(); 
	my $fromjid		= $presence->GetFrom("jid")->GetJID();
	my $from		= $presence->GetFrom();	
	my $priority	= $presence->GetPriority();
	my $status		= $presence->GetStatus();
	my $show		= $presence->GetShow();

	$debug->Log1("presenceCB: presence(",$presence->GetXML(),")");

	# Ignorable JIDs. (Certain "noisy" chatbot services come to mind!)
	foreach my $ignoreable_jid (@{$config{site}{ignore_jids}}) {
		if ($from =~ /$ignoreable_jid/) {
			$debug->Log2("presenceCB: ignoring ($ignoreable_jid)");
			return;
		}
    }

	# Log this occurance into the database

	$sqlquery = "INSERT INTO presence (presence_from,presence_type, presence_priority,";
	$sqlquery .= "presence_status,presence_show) VALUES (";
	$sqlquery .= $dbh->quote($from). ",";
	$sqlquery .= $dbh->quote($type). ",";
	$sqlquery .= $dbh->quote($priority). ",";
	$sqlquery .= $dbh->quote($status). ",";
	$sqlquery .= $dbh->quote($show). ")";

  my $sth = $dbh->prepare($sqlquery);
  $sth->execute;


	# +------------------------------------------------------------------------+
	# | User unsubscribes us from their presence                               |
	# +------------------------------------------------------------------------+
	if ($type eq "unsubscribe")
	{
		$debug->Log0("PresenceCB: $from is no longer subscribed to Bandersnatch");
		$dbh->do("UPDATE user SET user_subscribed = 'N' WHERE (user_jid = '$fromjid')");
	}

	# +------------------------------------------------------------------------+
	# | User accespts our subscription request                                 |
	# +------------------------------------------------------------------------+
	elsif ($type eq "subscribed")
	{
		$debug->Log0("PresenceCB: $from is now subscribed to Bandersnatch");
		$component->PresenceSend(to=>$from, from=>$config{component}->{name});
		$dbh->do("UPDATE user SET user_subscribed = 'Y' WHERE (user_jid = '$fromjid')");
	}
	
	# +------------------------------------------------------------------------+
	# | User has become unavailable                                            |
	# +------------------------------------------------------------------------+
	elsif ($type eq "unavailable")
	{
		#do nothing, we'll handle the logging later on
	}

	# +------------------------------------------------------------------------+
	# | Request subscription from unsubscribed user                            |
	# +------------------------------------------------------------------------+
	else
	{
		$debug->Log0("PresenceCB: $from has changed their presence, sending ours...");
		$component->PresenceSend(to=>$from, from=>$config{component}->{name});
	}

	# +------------------------------------------------------------------------+
	# | Log prescence for local users
	# +------------------------------------------------------------------------+
 


  my $local_server = $config{site}{local_server};
 	if (($fromjid =~ /\@$local_server/) && (!($type =~ /subscribe/))) # Don't worry about subscriptions
	{
		my $custom_status;
		# Define a custom status, because jabber's defaults will be null
		if ((($type eq "unavailable") && (!$status)) || (lc($status) eq "invisible")) {
			$custom_status = "invisible"; 
		} elsif ((!$type) && (!$show)) {
			$custom_status = "online";
		} elsif (($type eq "unavailable") && ($status)) {
			$custom_status = "offline"; 			
		} else {
			$custom_status = $show;
		}
		
		my $sth = $dbh->prepare("SELECT count(*) FROM user WHERE (user_jid = '$fromjid')");
		$sth->execute;
		my ($jid_exists) = $sth->fetchrow_array();
		if ($jid_exists > 1)
		{
			die("Something VERY wrong, two jids, both primary keys!");
		}
		elsif ($jid_exists == 0) {
			$dbh->do("INSERT INTO user SET user_jid = '$fromjid', user_status='$custom_status'");
		} else {
			$dbh->do("UPDATE user SET user_status='$custom_status' WHERE user_jid = '$fromjid'");
		}		
	}

}



# +----------------------------------------------------------------------------+
# | Handle <iq/> Packets                                                       |
# +----------------------------------------------------------------------------+
sub iqCB {


	my $sid		= shift;
	my $iq		= shift;
	my $query	= $iq->GetQuery();
	my $iqReply = $iq->Reply(template=>"component", type=>"result");

	$debug->Log1("iqCB: iq(".$iq->GetXML().")");

	if (!$query)
	{
		return;
	}
	
	# +------------------------------------------------------------------------+
	# | jabber:iq:version                                                      |
	# +------------------------------------------------------------------------+
	if ($query->GetXMLNS() eq "jabber:iq:version")
	{
		my $iqReplyQuery = $iqReply->NewQuery("jabber:iq:version");
		
		my $os = `uname -s -r`;
		chomp($os);

		$iqReplyQuery->SetVersion(name=>"Bandersnatch", ver=>$VERSION, os=>$os);
	}

	# +------------------------------------------------------------------------+
	# | jabber:iq:last                                                         |
	# +------------------------------------------------------------------------+
	elsif ($query->GetXMLNS() eq "jabber:iq:last")
	{
		my $iqReplyQuery = $iqReply->NewQuery("jabber:iq:last");
		
		$iqReplyQuery->SetSeconds(timerValue());
	}

	# +------------------------------------------------------------------------+
	# | Send <iq/> Reply                                                       |
	# +------------------------------------------------------------------------+
	if ($iqReply ne "") {
		$debug->Log1("iqCB: reply(",$iqReply->GetXML(),")");
		$component->Send($iqReply);
	} else {
		$debug->Log1("iqCB: no reply");
	}

}



# +----------------------------------------------------------------------------+
# | Connect to Jabber Server                                                   |
# +----------------------------------------------------------------------------+

sub connectJabber
{
    if (($config{server}->{connectiontype} eq "tcpip") || ($config{server}->{connectiontype} eq "accept"))
    {
        $status = $component->Connect(hostname      => $config{server}->{hostname},
                                      port          => $config{server}->{port},
                                      secret        => $config{server}->{secret},
                                      componentname => $config{component}->{name});
    }

    if (($config{server}->{connectiontype} eq "stdinout") || ($config{server}->{connectiontype} eq "exec"))
    {
        $status = $component->Connect(connectiontype=>"exec");
    }

	if (!defined($status))
	{
    	return 0; 
	}

	timerStart();

	return 1;
}



# +----------------------------------------------------------------------------+
# | Connect to Database Server                                                 |
# +----------------------------------------------------------------------------+

sub connectDatabase
{

	$dbh = DBI->connect("DBI:mysql:database=$config{mysql}->{dbname}:$config{mysql}->{server}",
						$config{mysql}->{username}, $config{mysql}->{password});

	if (!defined($dbh))
	{
		return 0;
	}

	$dbh->trace(2) if (($config{debug}->{level} > 0) && defined($dbh));

	return 1;

}

# +----------------------------------------------------------------------------+
# | Start Uptime Timer                                                         |
# +----------------------------------------------------------------------------+

sub timerStart
{
	$timer = time();

	return 1;
}

# +----------------------------------------------------------------------------+
# | Get Elapsed Time                                                           |
# +----------------------------------------------------------------------------+

sub timerValue
{
	return time() - $timer;
}

# +----------------------------------------------------------------------------+
# | Generate presence history for a given JID                                  |
# +----------------------------------------------------------------------------+
sub generate_presence_history
{
	my $from = shift;
	my $status_lines = "Presence History\n";
	$status_lines .= "--------------\n";
	
	######## Presence History ###########
	# Work out last status of yesterday
	my $date_condition = "(TO_DAYS(NOW()) - TO_DAYS(presence_timestamp) > 0)";
	my $sqlquery = "SELECT presence_type, presence_status, presence_show FROM presence WHERE presence_from LIKE '%$from%' AND presence_type NOT LIKE 'probe' AND presence_type NOT LIKE '%subscribe' AND $date_condition ORDER BY presence_timestamp DESC LIMIT 0,1";
	my $sth = $dbh->prepare($sqlquery);	 	
	$sth->execute;

	#------- First, work out the most recent presence that's NOT today
	my $yesterday_presence;
	my $status;
	while (my @data = $sth->fetchrow_array()) {
		my $type 	= $data[0]; 
		$status 	= $data[1]; 
		my $show 	= $data[2]; 
		$yesterday_presence = determine_presence($type,$status,$show);
	}
	if (!$yesterday_presence) { $yesterday_presence = "offline"; } # If no results were returned, he's never logged in
	my %time_array;
	
	$time_array{"00h00"}->{'presence'} = $yesterday_presence;
	$time_array{"00h00"}->{'status'} = $status;	


	# ------- Get today's presences
	$date_condition = "DATE_FORMAT( presence_timestamp, '%Y%m%d' ) = DATE_FORMAT( now( ) , '%Y%m%d' ) ";
	$sqlquery = "SELECT presence_type, presence_status, presence_show, DATE_FORMAT(presence_timestamp, '%Hh%i') as presence_timestamp_formatted FROM presence WHERE presence_from LIKE '%$from%' AND $date_condition ORDER BY presence_timestamp";
	$sth = $dbh->prepare($sqlquery);
	$sth->execute;
	
	while (my @data = $sth->fetchrow_array()) {
		my $type 		= $data[0]; 
		my $status 		= $data[1]; 
		my $show 		= $data[2]; 
		my $timestamp 	= $data[3];
		
		my $presence;
		if (($type !~ /probe/) && ($type !~ /subscribe/)) {
			$presence 	= determine_presence($type,$status,$show);
			$time_array{$timestamp}->{ 'presence' } = $presence;
			$time_array{$timestamp}->{ 'status' } = $status;
		}								
								# this way, we always get the minute's latest presence!
	}



  #------- Time-travel. Insert the future date into the past array :)
    my $oldpresence;
	my $old_timestamp;
	my $timestamp;
	my %clean_time_array;
	foreach my $timestamp ( sort keys %time_array ) {
		my $presence  = $time_array{$timestamp}->{ 'presence' };
		my $duplicate;
		
		if ($presence eq $oldpresence) { $duplicate = 1; }
		$oldpresence = $presence;

		if ($duplicate != 1) {
			if ($old_timestamp) {
				$clean_time_array{$old_timestamp}->{'future_timestamp'} = $timestamp;
			}
			$clean_time_array{$timestamp}->{'status'} 				= $time_array{$timestamp}->{'status'};
			$clean_time_array{$timestamp}->{'presence'} 			= $time_array{$timestamp}->{'presence'};
					
		$old_timestamp = $timestamp;
	}
}
  
  
  #---------- Create the presence list
  $oldpresence = "";
	for $timestamp (sort keys %clean_time_array ) {
		my $presence  		 = $clean_time_array{$timestamp}->{presence};
		my $status	 	 	 = $clean_time_array{$timestamp}->{status};
		my $future_timestamp = $clean_time_array{$timestamp}->{future_timestamp};
		
		my %nice_names = (
							"xa"		=> "Extended Away",
							"offline" 	=> "Offline",
							"online"  	=> "Online",
							"away"		=> "Away",
							"chat"		=> "Available For Chat",
							"dnd"		=> "Do Not Disturb",
							"invisible"	=> "Invisible" );
		my $duplicate;
		
		if(!$future_timestamp) { 
			$future_timestamp = "Now"; 
		}

		my $pretty_status;
		if (($status !~ /$presence/i) && ($status !~ /subscri/i) && ($status)) {
			$pretty_status = "( $status )";
		}
		$status_lines .= "[ $timestamp - $future_timestamp ] ". $nice_names{$presence}. " $pretty_status \n";

	}

	$status_lines .= "\n";
}

#
# Create message stats
#
sub generate_message_summary
{
	my $jid  = shift;
	my $date = shift;
	
	my $sqlquery;
	my $stats;
 	my $date_condition = "DATE_FORMAT( message_timestamp, \'%Y%m%d\' ) = DATE_FORMAT( $date , \'%Y%m%d\' ) ";

  ############ Start sent_local ################
  my $local_domain_condition = "";
  foreach my $local_domain (@{$config{site}{local_domains}}) {
    $local_domain_condition .= " message_to LIKE '%\@$local_domain%' OR";
  }
  $local_domain_condition = substr($local_domain_condition,0,-3);
	$sqlquery = "SELECT count( * ) FROM message WHERE message_from LIKE '$jid%' AND ($local_domain_condition) AND $date_condition";
	my $sth = $dbh->prepare($sqlquery);
	$sth->execute;
	my $sent_local = $sth->fetchrow_array();
  ############# Finished sent_local ############


  ############ Start sent_local ################
	$local_domain_condition = "";
  foreach my $local_domain (@{$config{site}{local_domains}}) {
    $local_domain_condition .= " message_from LIKE '%\@$local_domain%' OR";
  }
  $local_domain_condition = substr($local_domain_condition,0,-3);
	$sqlquery = "SELECT count( * ) FROM message WHERE message_to LIKE '$jid%' AND ($local_domain_condition) AND $date_condition";
	$sth = $dbh->prepare($sqlquery);
	$sth->execute;
	my ($received_local) = $sth->fetchrow_array();
  ############ Finished sent_local #############


  ############ Start total_local ################
  my $local_domain_condition_to;
  my $local_domain_condition_from;
  foreach my $local_domain (@{$config{site}{local_domains}}) {
  	$local_domain_condition_to   .= " message_to LIKE '%\@$local_domain%' OR";
		$local_domain_condition_from .= " message_from LIKE '%\@$local_domain%' OR";
	}
	$local_domain_condition_to   = substr($local_domain_condition_to,0,-3);
	$local_domain_condition_from = substr($local_domain_condition_from,0,-3);
	$sqlquery = "SELECT count( * ) FROM message WHERE (($local_domain_condition_to) AND ($local_domain_condition_from)) AND $date_condition ";
	$sth = $dbh->prepare($sqlquery);
	$sth->execute;
	my ($total_local) = $sth->fetchrow_array();
  ############ Finished total_local ################


	my $percentage_local;
	if ($total_local == 0) { $percentage_local = 0; # Never divide by zero! :)
	} else { $percentage_local = int((($received_local + $sent_local) / $total_local ) * 100);
	}
	
  ############ Start sent_remote ################
  $local_domain_condition = "";
  foreach my $local_domain (@{$config{site}{local_domains}}) {
		$local_domain_condition .= " AND message_to NOT LIKE '%\@$local_domain%'";
	}
	$sqlquery = "SELECT count( * ) FROM message WHERE message_from LIKE '$jid%' $local_domain_condition AND $date_condition";
	$sth = $dbh->prepare($sqlquery);
	$sth->execute;
	my ($sent_remote) = $sth->fetchrow_array();
  ############ Finished sent_local ################
  
  
  ############ Start received_remote ################
	$local_domain_condition = "";
	foreach my $local_domain (@{$config{site}{local_domains}}) {
		$local_domain_condition .= " AND message_from NOT LIKE '%\@$local_domain%'";
	}
	$sqlquery = "SELECT count( * ) FROM message WHERE message_to LIKE '$jid%' $local_domain_condition AND $date_condition";
	$sth = $dbh->prepare($sqlquery);
	$sth->execute;
	my ($received_remote) = $sth->fetchrow_array();
  ############ Finish received_remote ################
	

  ############ Start total_remote ################
  $local_domain_condition_to = "";
  $local_domain_condition_from ="";
  foreach my $local_domain (@{$config{site}{local_domains}}) {
		$local_domain_condition_to   .= " message_to NOT LIKE '%\@$local_domain%' AND";
		$local_domain_condition_from .= " message_from NOT LIKE '%\@$local_domain%' AND";
    }
	$local_domain_condition_to   = substr($local_domain_condition_to,0,-4); # trim final AND
	$local_domain_condition_from = substr($local_domain_condition_from,0,-4);
  $sqlquery = "SELECT count( * ) FROM message WHERE (($local_domain_condition_to) OR ($local_domain_condition_from)) AND $date_condition ";
	$sth = $dbh->prepare($sqlquery);
	$sth->execute;
	my ($total_remote) = $sth->fetchrow_array();
  ############ Finish sent_local ################
 
 
	my $percentage_remote;
	if ($total_remote == 0) { $percentage_remote = 0;  # Never divide by zero! :)
	} else { $percentage_remote = int((($received_remote + $sent_remote) / $total_remote ) * 100);	
	}
  
	if ($total_local > 0) {
     $stats .= "Local messages\n";
     $stats .= "--------------\n";
	   $stats .= "Sent:     $sent_local messages\n";
	   $stats .= "Received: $received_local messages\n";
     if ($jid) {
        $stats .= "Percentage: $percentage_local% of total ($total_local)\n\n";
     } else {
        $stats .= "Total: $total_local\n\n";
     }
  }
  if ($total_remote > 0) {
	   $stats .= "Remote messages\n";
	   $stats .= "--------------\n";
	   $stats .= "Sent:     $sent_remote messages\n";
	   $stats .= "Received: $received_remote messages\n";
	   if ($jid) {
        $stats .= "Percentage: $percentage_remote% of total ($total_remote)\n\n";
     } else {
        $stats .= "Total: $total_remote\n\n";
     }
  }
  if (($total_remote == 0) && ($total_local == 0)) {
     $stats = "No messages logged";
  }
	$stats;
}

#
# Create top users
#
sub generate_top_list
{
	my $jid = shift;
	my $date 		= shift;
	my $amount = shift;
	
	my $sqlquery;
  my $local_top;
  my $remote_top;
	my $message = "";
	my $date_condition = "DATE_FORMAT( message_timestamp, \'%Y%m%d\' ) = DATE_FORMAT( $date , \'%Y%m%d\' ) ";
	
	############## Local ################
	# Remote

	# Total messages sent today
  my $local_domain_condition;
  foreach my $local_domain (@{$config{site}{local_domains}}) {
    $local_domain_condition .= " message_to LIKE '%\@$local_domain%' OR";
  }
  $local_domain_condition = substr($local_domain_condition,0,-3);

	$sqlquery = "SELECT count(*) as count, message_to FROM message WHERE message_from LIKE '$jid%' AND ($local_domain_condition) AND $date_condition GROUP BY message_to ORDER BY count DESC LIMIT 0,$amount";
	my $sth = $dbh->prepare($sqlquery);
	$sth->execute;
	
	while (my @data = $sth->fetchrow_array()) {
		my $count 		= $data[0]; 
		my $recipient	= $data[1];
		
		if ($recipient =~ /([^\/]+)\// ) { # strip the resource
			 $recipient = $1;
		}

    $local_top .= "$recipient (sent $count)\n";
	}	
  if ($local_top) {
    $message .= "Top local\n";
   	$message .= "---------\n";
    $message .= $local_top;
  }
	

	############## Remote ################
	# Total messages sent today
  $local_domain_condition = "";
  foreach my $local_domain (@{$config{site}{local_domains}}) {
		$local_domain_condition .= " AND message_to NOT LIKE '%\@$local_domain%'";
	}
	$sqlquery = "SELECT count(*) as count, message_to FROM message WHERE message_from LIKE '$jid%' $local_domain_condition AND $date_condition GROUP BY message_to ORDER BY count DESC LIMIT 0,$amount";

	$sth = $dbh->prepare($sqlquery);
	$sth->execute;
	
	while (my @data = $sth->fetchrow_array()) {
		my $count 		= $data[0];
		my $recipient	= $data[1];
		
		if ($recipient =~ /([^\/]+)\// ) { # strip the resource
			 $recipient = $1;
		}

    $remote_top .= "$recipient (sent $count)\n";
	}
  if ($remote_top) {
    $message .= "\nTop remote\n";
   	$message .= "------------\n";
    $message .= $remote_top;
  }


	$message;
}

# +----------------------------------------------------------------------------+
# | Handle Shutdown Gracefully                                                 |
# +----------------------------------------------------------------------------+
sub Shutdown
{

	$debug->Log0("Disconnecting from Jabber server ($config{server}->{hostname}) ...");
	$component->Disconnect();
	$debug->Log0("Disconnecting from MySQL server ($config{mysql}->{server}) ...");
	$dbh->disconnect();
	exit(0);
}

