online2 script

#!/usr/bin/perl -w

###############################################################################
# 
# Show users online - for Jabberd2 servers.
#
#
# Written by Aryeh  Goldsmith - http://www.aryeh.net/
#      Mon Aug  9 12:29:18 EDT 2004
#
# This code comes with no warranty of any kind.  You are free to do whatever
#  you wish with it.  There is the very slim possibility that this piece of
#  code may infiltrate your Jabber server, jump onto the computers of all the 
#  members logged into the system, send copious amounts of spam from their
#  computers, then erase their hard drive, and spin every motor, fan, drive
#  and moveable part in a synchronized rhythm until it turns into a raging 
#  thumping electro-magnetic beast destroying all data in a 50 foot radius of 
#  itself,  disrupting all electrical devices, and resetting the time on all
#  kitchen microwaves, and clock radios causing people to be late for work,
#  and appointments, causing everyone to rush to work, causing extreme traffic 
#  and massive pileups on our highways and roads, disrupting the abililty for
#  medical, fire and emeregency vehicles from responding in a timely fashion
#  causing many to suffer and perhaps even die.  If you care for human life
#  you may not want to use this code.  You are forewarned - don't blame me.  
#
#  To all you other folks, enjoy, and I hope this helps ya!
#  
#
# Make my day ... send me a hundred emails. I mean dollars.
#  :a) 
#


use strict;
use Jabber::Connection;

my $jabber_server = 'somechatserver.com';
my $jabber_admin_user = 'JabberAdmin';
my $jabber_admin_pass = 'JabberPass';

#
# put the hosts you want to query here.
#   you will need to have your JID configured to have admin priveleges for the server
#
my @q_hosts = qw/host1.somechatserver.com host2.somechatserver.com/;

my $DEBUG = 0;

my $nf = new Jabber::NodeFactory();
my @online_users;


#
# Let's go... easy as 3.14159265
#

my $jabber_connection = new Jabber::Connection(server => $jabber_server);
  die "ERROR: " . $jabber_connection->lastError unless $jabber_connection->connect();

$jabber_connection->auth($jabber_admin_user,$jabber_admin_pass,'jabberd');


foreach my $q_host (@q_hosts) {

  my $node = $nf->newNode('iq');
  $node->attr('type', 'get');
  $node->attr('to', $q_host);

  my $query = $node->insertTag('query', 'http://jabber.org/protocol/disco#items');
  $query->attr('node', 'sessions');

  print "Query:\n" . $node->toStr . "\n\n" if ($DEBUG);

  my $result = $jabber_connection->ask($node);

  print "Result:\n" . $result->toStr . "\n\n" if ($DEBUG);

  my @items = $result->getTag('query')->getTag('item');


  foreach (@items) {
     print $_->attr('jid') . ' - ' .  $_->attr('name') . "\n" if ($DEBUG);

     push(@online_users, { 
        'jid'   => $_->attr('jid'),
        'name'  => $_->attr('name') 
        } );
  }

}

$jabber_connection->disconnect();

#
# at this point we have an array of hashrefs of online users.
#  These users are now at your mercy, do with them as you please.
#
print @online_users . " users online:\n";
foreach my $ou (@online_users) {
  print "\t" . $ou->{jid} . ' (' . $ou->{name} . ")\n";
}

exit;