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