/usr/share/doc/libnet-jabber-loudmouth-perl/examples/lm-test-tunnel.pl is in libnet-jabber-loudmouth-perl 0.07-2build2.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 | #!/usr/bin/perl
use strict;
use warnings;
use Net::Jabber::Loudmouth;
if (@ARGV < 5) {
print "Usage: $0 <server> <username> <password> <connectserver> <connectport>\n";
exit 1;
}
my $connection = Net::Jabber::Loudmouth::Connection->new($ARGV[3]);
my $jid = $ARGV[1].'@'.$ARGV[0];
$connection->set_jid($jid);
$connection->set_port($ARGV[4]);
my $handler = Net::Jabber::Loudmouth::MessageHandler->new(\&handle_message);
$connection->register_message_handler($handler, 'message', 'normal');
my $info = {
name => $ARGV[1],
passwd => $ARGV[2]
};
$connection->open(\&connection_open_cb, $info);
print "Returned from the connection->open()\n";
my $main_loop = Glib::MainLoop->new();
$main_loop->run();
sub handle_message {
my ($handler, $connection, $m) = @_;
printf "Incoming message from %s\n", $m->get_node->get_attribute('from');
return 'remove-message';
}
sub connection_open_cb {
my ($connection, $result, $info) = @_;
print "Connected callback\n";
$connection->authenticate($info->{name}, $info->{passwd}, "LmTest", \&authentication_cb, $info);
print "Sent auth message\n";
}
sub authentication_cb {
my ($connection, $result) = @_;
printf "Auth: %d\n", $result;
if ($result) {
my $m = Net::Jabber::Loudmouth::Message->new_with_sub_type('', 'presence', 'available');
printf ":: %s\n", $m->get_node->to_string();
$connection->send($m);
}
}
|