/usr/share/doc/libnet-jabber-loudmouth-perl/examples/lm-test.pl is in libnet-jabber-loudmouth-perl 0.07-3+b3.
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 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 | #!/usr/bin/perl
use strict;
use warnings;
use Net::Jabber::Loudmouth;
if (@ARGV < 3) {
print STDERR "Usage: $0 <server> <username> <password> [<fingerprint>]\n";
exit 1;
}
my $connection = Net::Jabber::Loudmouth::Connection->new($ARGV[0]);
if (@ARGV > 3 && !Net::Jabber::Loudmouth::SSL->is_supported()) {
print STDERR "No SSL support!\n";
exit 2;
}
my $handler = Net::Jabber::Loudmouth::MessageHandler->new(\&handle_message);
$connection->register_message_handler($handler, 'message', 'normal');
my $info = {
name => $ARGV[1],
passwd => $ARGV[2]
};
if (@ARGV > 3) {
$connection->set_port($Net::Jabber::Loudmouth::DefaultPortSSL);
my $ssl = Net::Jabber::Loudmouth::SSL->new(\&ssl_cb, $info, $ARGV[3]);
$connection->set_ssl($ssl);
}
$connection->open(\&connection_open_cb, $info);
my $main_loop = Glib::MainLoop->new();
$main_loop->run();
sub print_finger {
my ($fpr, $size) = @_;
for (my $i = 0; $i < $size-1; $i++) {
my $c;
{ no warnings;
$c = substr($fpr, $i, 1); }
$c &&= ord $c;
$c ||= 0;
printf "%02X:", $c;
}
my $c;
{ no warnings;
$c = substr($fpr, $size-1, 1); }
$c &&= ord $c;
$c ||= 0;
printf "%02X", $c;
}
sub ssl_cb {
my ($ssl, $status, $ud) = @_;
print "SSL status: $status\n";
if ($status eq 'cert-fingerprint-mismatch') {
my $fpr = $ssl->get_fingerprint();
print "Certificate fingerprint does not match expected fingerprint!\n";
print "Remote fingerprint: ";
print_finger($fpr, 16);
print "\nExpected fingerprint: ";
print_finger($ARGV[3], 16);
print "\n";
} elsif ($status eq 'generic-error') {
print "Generic SSL error!\n";
}
return 'continue';
}
sub connection_open_cb {
my ($connection, $result, $info) = @_;
print "Connected callback!\n";
$connection->authenticate($info->{name}, $info->{passwd}, "LmTest", \&authenticate_cb);
print "Sent auth message\n";
}
sub authenticate_cb {
my ($connection, $result, $ud) = @_;
print "Auth: $result\n";
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);
}
}
sub handle_message {
my ($handler, $connection, $m) = @_;
printf "Incoming message from %s\n", $m->get_node->get_attribute('from');
return 'remove-message';
}
|