#!/usr/bin/perl -w
sub
describe_server;
sub
describe_class;
sub
read_server;
sub
usage {
print
STDERR
"Usage: myserver.pl --username [HOSTNAME] --server [SERVER] --port [PORT] --resource [RESOURCE] --password [PASSWORD]\n"
;
}
sub
main {
my
$username
=
undef
;
my
$server
=
undef
;
my
$port
= 5222;
my
$resource
=
"MyServerClient"
;
my
$help
=
undef
;
my
$password
=
undef
;
GetOptions (
"username=s"
=> \
$username
,
"server=s"
=> \
$server
,
"port=i"
=> \
$port
,
"resource=s"
=> \
$resource
,
"password=s"
=> \
$password
,
"help"
=> \
$help
);
if
(
$help
) {
usage();
exit
(0);
}
my
$con
= new Net::Jabber::Client();
my
$status
=
$con
->Connect(
hostname
=>
$server
,
port
=>
$port
);
if
(!(
defined
(
$status
))) {
print
"ERROR: Jabber server is down or connection was not allowed.\n"
;
print
" ($!)\n"
;
exit
(0);
}
my
@result
=
$con
->AuthSend(
username
=>
$username
,
password
=>
$password
,
resource
=>
$resource
);
if
(
$result
[0] ne
"ok"
) {
print
"ERROR: Authorization failed: $result[0] - $result[1]\n"
;
exit
(0);
}
$con
->RosterGet();
$con
->PresenceSend();
describe_server(
$con
);
describe_class(
$con
);
read_server(
$con
);
$con
->Disconnect;
}
sub
describe_server {
my
$con
=
shift
;
my
$desc
= new Net::Jabber::IQ;
$desc
->SetIQ(
to
=>
'joap.localhost'
,
type
=>
'get'
);
$desc
->NewQuery(
$JOAP::NS
,
'describe'
);
my
$desc_res
=
$con
->SendAndReceiveWithID(
$desc
);
print
$desc_res
->GetXML,
"\n"
;
}
sub
describe_class {
my
$con
=
shift
;
my
$desc
= new Net::Jabber::IQ;
$desc
->SetIQ(
to
=>
'Person@joap.localhost'
,
type
=>
'get'
);
$desc
->NewQuery(
$JOAP::NS
,
'describe'
);
my
$desc_res
=
$con
->SendAndReceiveWithID(
$desc
);
print
$desc_res
->GetXML,
"\n"
;
}
sub
read_server {
my
$con
=
shift
;
my
$read
= new Net::Jabber::IQ;
$read
->SetIQ(
to
=>
'joap.localhost'
,
type
=>
'get'
);
$read
->NewQuery(
$JOAP::NS
,
'read'
);
my
$read_res
=
$con
->SendAndReceiveWithID(
$read
);
print
$read_res
->GetXML,
"\n"
;
}
&main
();