#!/opt/perl/bin/perl
use strict;
use utf8;
use AnyEvent;
use AnyEvent::XMPP::Client;
use AnyEvent::XMPP::Ext::Version;
use POSIX qw/strftime/;
my ($jid,$pass) = qw/net_xmpp2@jabber.org test/;
($jid, $pass) = @ARGV if @ARGV;
sub timestamp {
strftime "%d%m%Y_%H%M", localtime (time);
}
my $TIMESTAMP = timestamp ();
sub append_outputfile {
open OUT, ">>disco_version.\Q$TIMESTAMP\E.output"
or die "Couldn't open disco_version.output: $!\n";
print OUT $_[0];
close OUT;
}
sub append_failed {
open OUT, ">>disco_version.\Q$TIMESTAMP\E.failed"
or die "Couldn't open disco_version.output: $!\n";
print OUT $_[0];
close OUT;
}
my %req;
my ($out_cnt, $in_cnt);
sub version_req {
my ($vers, $con, $dest) = @_;
return if $req{$dest};
$out_cnt++;
$vers->request_version ($con, $dest, sub {
my ($version, $error) = @_;
$in_cnt++;
if ($error) {
warn "$dest: DISCO VERSION ERROR $dest: " . $error->string . "\n";
append_failed ("$dest\t".$error->string."\n");
} else {
my $from = $version->{jid};
my $name = $version->{name};
my $ver = $version->{version};
my $os = $version->{os};
$ver =~ s/[\n\t]//g;
$name =~ s/[\n\t]//g;
$os =~ s/[\n\t]//g;
print "$dest: $from: name: $name version: $ver os: $os\n";
append_outputfile ("$from\t$name\t$ver\t$os\n");
}
});
}
my $j = AnyEvent->condvar;
my $cl = AnyEvent::XMPP::Client->new;# (debug => 1);
my $vers = AnyEvent::XMPP::Ext::Version->new;
$cl->add_extension ($vers);
my $t = undef;
my @jids = map { chomp; $_ } <STDIN>;
sub mkti {
my ($con) = @_;
$t = AnyEvent->timer (after => 1, cb => sub {
for (1..50) {
my $j = pop @jids;
if ($j) {
version_req ($vers, $con, $j);
} else {
print "no more jids to query ($out_cnt/$in_cnt)...\n";
last;
}
}
mkti ($con);
});
}
$cl->add_account ($jid, $pass);#, undef, undef, { disable_ssl => 1 });
$cl->reg_cb (
session_ready => sub {
my ($cl, $acc) = @_;
$acc->connection->set_default_iq_timeout (300);
warn "session ready!\n";
mkti ($acc->connection);
$cl->unreg_me
},
disconnect => sub {
my ($cl, $acc, $h, $p, $reas) = @_;
print "disconnect ($h:$p): $reas\n";
},
error => sub {
my ($cl, $acc, $err) = @_;
print "ERROR: " . $err->string . "\n";
},
message => sub {
my ($cl, $acc, $msg) = @_;
print "message from: " . $msg->from . ": " . $msg->any_body . "\n";
}
);
$cl->start;
$j->wait;