#!/opt/perl/bin/perl use strict; use utf8; use AnyEvent; use AnyEvent::XMPP::Client; use AnyEvent::XMPP::Ext::Disco; use AnyEvent::XMPP::Ext::DataForm; use Storable; use XML::DOM::XPath; use IO::Handle; use EVQ; my @servers = map { s/^\s*(\S+)\s*$/\1/; $_ } <STDIN>; my $cl = AnyEvent::XMPP::Client->new (); my $d = AnyEvent::XMPP::Ext::Disco->new; $cl->add_extension ($d); $cl->add_account ('net_xmpp2@jabber.org/test', 'test'); sub disco_info { my ($con, $jid, $cb) = @_; EVQ::push_request ("di_$jid", sub { my $ID = shift; warn ">>$jid?\n"; $d->request_info ($con, $jid, undef, sub { my ($d, $i, $e) = @_; if ($e) { warn "error on disco info on $jid: " . $e->string . "\n"; } else { $cb->($i); } EVQ::finreq ($ID) }); }); } sub disco_items { my ($con, $jid, $cb) = @_; EVQ::push_request ("dit_$jid", sub { my $ID = shift; $d->request_items ($con, $jid, undef, sub { my ($d, $i, $e) = @_; if ($e) { warn "error on disco items on $jid: " . $e->string . "\n"; } else { $cb->($i); } EVQ::finreq ($ID) }); }); } sub fetch_room_occupants { my ($con, $jid, $cb) = @_; EVQ::push_request ("fro_$jid", sub { my $ID = shift; $d->request_info ($con, $jid, undef, sub { my ($d, $i, $e) = @_; if ($e) { warn "error on disco info to $jid for room occupants: " . $e->string . "\n"; } else { my (@q) = $i->xml_node ()->find_all ([qw/data_form x/]); if (@q) { my $df = AnyEvent::XMPP::Ext::DataForm->new; $df->from_node (@q); if (my $f = $df->get_field ('muc#roominfo_occupants')) { $cb->($jid, $f->{values}->[0]); EVQ::finreq ($ID); return; } } $cb->($jid); } EVQ::finreq ($ID); }); }); } my $con; my $A = AnyEvent->condvar; $cl->reg_cb ( error => sub { my ($cl, $acc, $err) = @_; warn "ERROR: " . $err->string . "\n"; 1 }, iq_result_cb_exception => sub { my ($cl, $acc, $ex) = @_; warn "EXCEPTION: $ex\n"; 1 }, session_ready => sub { my ($cl, $acc) = @_; warn "session ready, requesting items for $ARGV[0]\n"; my $c = $acc->connection (); $c->set_default_iq_timeout (30); $con = $c; $A->broadcast; 0 }, message => sub { my ($cl, $acc, $msg) = @_; warn "message from: " . $msg->from . ": " . $msg->any_body . "\n"; 1 } ); $cl->start; $A->wait; EVQ::start (); open SERVEROUT, ">servers.list.txt" or die "servers.list.txt: $!"; for my $SERVER (@servers) { warn "$SERVER?\n"; disco_info ($con, $SERVER, sub { my ($i) = @_; my @c = grep { $_->{category} eq 'server' } $i->identities (); if (@c) { print SERVEROUT $i->jid . "\n"; SERVEROUT->flush; } }); } EVQ::wait ();