| line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
|
1
|
|
|
|
|
|
|
############################################################################## |
|
2
|
|
|
|
|
|
|
# |
|
3
|
|
|
|
|
|
|
# This library is free software; you can redistribute it and/or |
|
4
|
|
|
|
|
|
|
# modify it under the terms of the GNU Library General Public |
|
5
|
|
|
|
|
|
|
# License as published by the Free Software Foundation; either |
|
6
|
|
|
|
|
|
|
# version 2 of the License, or (at your option) any later version. |
|
7
|
|
|
|
|
|
|
# |
|
8
|
|
|
|
|
|
|
# This library is distributed in the hope that it will be useful, |
|
9
|
|
|
|
|
|
|
# but WITHOUT ANY WARRANTY; without even the implied warranty of |
|
10
|
|
|
|
|
|
|
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
|
11
|
|
|
|
|
|
|
# Library General Public License for more details. |
|
12
|
|
|
|
|
|
|
# |
|
13
|
|
|
|
|
|
|
# You should have received a copy of the GNU Library General Public |
|
14
|
|
|
|
|
|
|
# License along with this library; if not, write to the |
|
15
|
|
|
|
|
|
|
# Free Software Foundation, Inc., 59 Temple Place - Suite 330, |
|
16
|
|
|
|
|
|
|
# Boston, MA 02111-1307, USA. |
|
17
|
|
|
|
|
|
|
# |
|
18
|
|
|
|
|
|
|
# Copyright (C) 1998-2004 Jabber Software Foundation http://jabber.org/ |
|
19
|
|
|
|
|
|
|
# |
|
20
|
|
|
|
|
|
|
############################################################################## |
|
21
|
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
package Net::Jabber::Component; |
|
23
|
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
=head1 NAME |
|
25
|
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
Net::Jabber::Component - Jabber Component Library |
|
27
|
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
=head1 SYNOPSIS |
|
29
|
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
Net::Jabber::Component is a module that provides a developer easy |
|
31
|
|
|
|
|
|
|
access to developing server components in the Jabber Instant Messaging |
|
32
|
|
|
|
|
|
|
protocol. |
|
33
|
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
=head1 DESCRIPTION |
|
35
|
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
Component.pm seeks to provide enough high level APIs and automation of |
|
37
|
|
|
|
|
|
|
the low level APIs that writing a Jabber Component in Perl is trivial. |
|
38
|
|
|
|
|
|
|
For those that wish to work with the low level you can do that too, |
|
39
|
|
|
|
|
|
|
but those functions are covered in the documentation for each module. |
|
40
|
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
Net::Jabber::Component provides functions to connect to a Jabber |
|
42
|
|
|
|
|
|
|
server, login, send and receive messages, operate as a server side |
|
43
|
|
|
|
|
|
|
component, and disconnect. You can use all or none of the functions, |
|
44
|
|
|
|
|
|
|
there is no requirement. |
|
45
|
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
For more information on how the details for how Net::Jabber is written |
|
47
|
|
|
|
|
|
|
please see the help for Net::Jabber itself. |
|
48
|
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
For a full list of high level functions available please see |
|
50
|
|
|
|
|
|
|
Net::Jabber::Protocol and Net::XMPP::Protocol. |
|
51
|
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
=head2 Basic Functions |
|
53
|
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
use Net::Jabber; |
|
55
|
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
$Con = new Net::Jabber::Component(); |
|
57
|
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
$Con->Execute(hostname=>"jabber.org", |
|
59
|
|
|
|
|
|
|
componentname=>"service.jabber.org", |
|
60
|
|
|
|
|
|
|
secret=>"XXXX" |
|
61
|
|
|
|
|
|
|
); |
|
62
|
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
# |
|
64
|
|
|
|
|
|
|
# For the list of available functions see Net::XMPP::Protocol. |
|
65
|
|
|
|
|
|
|
# |
|
66
|
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
$Con->Disconnect(); |
|
68
|
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
=head1 METHODS |
|
70
|
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
=head2 Basic Functions |
|
72
|
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
new(debuglevel=>0|1|2, - creates the Component object. debugfile |
|
74
|
|
|
|
|
|
|
debugfile=>string, should be set to the path for the debug |
|
75
|
|
|
|
|
|
|
debugtime=>0|1) log to be written. If set to "stdout" |
|
76
|
|
|
|
|
|
|
then the debug will go there. debuglevel |
|
77
|
|
|
|
|
|
|
controls the amount of debug. For more |
|
78
|
|
|
|
|
|
|
information about the valid setting for |
|
79
|
|
|
|
|
|
|
debuglevel, debugfile, and debugtime see |
|
80
|
|
|
|
|
|
|
Net::Jabber::Debug. |
|
81
|
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
AuthSend(secret=>string) - Perform the handshake and authenticate |
|
83
|
|
|
|
|
|
|
with the server. |
|
84
|
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
Connect(hostname=>string, - opens a connection to the server |
|
86
|
|
|
|
|
|
|
port=>integer, based on the value of |
|
87
|
|
|
|
|
|
|
componentname=>string, connectiontype. The only valid |
|
88
|
|
|
|
|
|
|
connectiontype=>string) setting is: |
|
89
|
|
|
|
|
|
|
accept - TCP/IP remote connection |
|
90
|
|
|
|
|
|
|
In the future this might be used |
|
91
|
|
|
|
|
|
|
again by offering new features. |
|
92
|
|
|
|
|
|
|
If accept then it connects to the |
|
93
|
|
|
|
|
|
|
server listed in the hostname |
|
94
|
|
|
|
|
|
|
value, on the port listed. The |
|
95
|
|
|
|
|
|
|
defaults for the two are localhost |
|
96
|
|
|
|
|
|
|
and 5269. |
|
97
|
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
Note: A change from previous |
|
99
|
|
|
|
|
|
|
versions is that Component now |
|
100
|
|
|
|
|
|
|
shares its core with Client. To |
|
101
|
|
|
|
|
|
|
that end, the secret should no |
|
102
|
|
|
|
|
|
|
longer be used. Call AuthSend |
|
103
|
|
|
|
|
|
|
after connecting. Better yet, |
|
104
|
|
|
|
|
|
|
use Execute. |
|
105
|
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
Connected() - returns 1 if the Component is connected to the server, |
|
107
|
|
|
|
|
|
|
and 0 if not. |
|
108
|
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
Disconnect() - closes the connection to the server. |
|
110
|
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
Execute(hostname=>string, - Generic inner loop to handle |
|
112
|
|
|
|
|
|
|
port=>int, connecting to the server, calling |
|
113
|
|
|
|
|
|
|
secret=>string, Process, and reconnecting if the |
|
114
|
|
|
|
|
|
|
componentname=>string, connection is lost. There are four |
|
115
|
|
|
|
|
|
|
connectiontype=>string, callbacks available that are called |
|
116
|
|
|
|
|
|
|
connectattempts=>int, at various places in the loop. |
|
117
|
|
|
|
|
|
|
connectsleep=>int) onconnect - when the component |
|
118
|
|
|
|
|
|
|
connects to the |
|
119
|
|
|
|
|
|
|
server. |
|
120
|
|
|
|
|
|
|
onauth - when the component has |
|
121
|
|
|
|
|
|
|
completed its handshake |
|
122
|
|
|
|
|
|
|
with the server this |
|
123
|
|
|
|
|
|
|
will be called. |
|
124
|
|
|
|
|
|
|
onprocess - this is the most |
|
125
|
|
|
|
|
|
|
inner loop and so |
|
126
|
|
|
|
|
|
|
gets called the most. |
|
127
|
|
|
|
|
|
|
Be very very careful |
|
128
|
|
|
|
|
|
|
what you put here |
|
129
|
|
|
|
|
|
|
since it can |
|
130
|
|
|
|
|
|
|
*DRASTICALLY* affect |
|
131
|
|
|
|
|
|
|
performance. |
|
132
|
|
|
|
|
|
|
ondisconnect - when connection is |
|
133
|
|
|
|
|
|
|
lost. |
|
134
|
|
|
|
|
|
|
onexit - when the function gives |
|
135
|
|
|
|
|
|
|
up trying to connect and |
|
136
|
|
|
|
|
|
|
exits. |
|
137
|
|
|
|
|
|
|
The arguments are passed straight |
|
138
|
|
|
|
|
|
|
on to the Connect function, except |
|
139
|
|
|
|
|
|
|
for connectattempts and |
|
140
|
|
|
|
|
|
|
connectsleep. connectattempts is |
|
141
|
|
|
|
|
|
|
the number of time that the |
|
142
|
|
|
|
|
|
|
Component should try to connect |
|
143
|
|
|
|
|
|
|
before giving up. -1 means try |
|
144
|
|
|
|
|
|
|
forever. The default is -1. |
|
145
|
|
|
|
|
|
|
connectsleep is the number of |
|
146
|
|
|
|
|
|
|
seconds to sleep between each |
|
147
|
|
|
|
|
|
|
connection attempt. |
|
148
|
|
|
|
|
|
|
|
|
149
|
|
|
|
|
|
|
Process(integer) - takes the timeout period as an argument. If no |
|
150
|
|
|
|
|
|
|
timeout is listed then the function blocks until |
|
151
|
|
|
|
|
|
|
a packet is received. Otherwise it waits that |
|
152
|
|
|
|
|
|
|
number of seconds and then exits so your program |
|
153
|
|
|
|
|
|
|
can continue doing useful things. NOTE: This is |
|
154
|
|
|
|
|
|
|
important for GUIs. You need to leave time to |
|
155
|
|
|
|
|
|
|
process GUI commands even if you are waiting for |
|
156
|
|
|
|
|
|
|
packets. The following are the possible return |
|
157
|
|
|
|
|
|
|
values, and what they mean: |
|
158
|
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
1 - Status ok, data received. |
|
160
|
|
|
|
|
|
|
0 - Status ok, no data received. |
|
161
|
|
|
|
|
|
|
undef - Status not ok, stop processing. |
|
162
|
|
|
|
|
|
|
|
|
163
|
|
|
|
|
|
|
IMPORTANT: You need to check the output of every |
|
164
|
|
|
|
|
|
|
Process. If you get an undef then the connection |
|
165
|
|
|
|
|
|
|
died and you should behave accordingly. |
|
166
|
|
|
|
|
|
|
|
|
167
|
|
|
|
|
|
|
=head1 AUTHOR |
|
168
|
|
|
|
|
|
|
|
|
169
|
|
|
|
|
|
|
Ryan Eatmon |
|
170
|
|
|
|
|
|
|
|
|
171
|
|
|
|
|
|
|
=head1 COPYRIGHT |
|
172
|
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
This module is free software; you can redistribute it and/or modify |
|
174
|
|
|
|
|
|
|
it under the same terms as Perl itself. |
|
175
|
|
|
|
|
|
|
|
|
176
|
|
|
|
|
|
|
=cut |
|
177
|
|
|
|
|
|
|
|
|
178
|
49
|
|
|
49
|
|
298
|
use strict; |
|
|
49
|
|
|
|
|
124
|
|
|
|
49
|
|
|
|
|
1686
|
|
|
179
|
49
|
|
|
49
|
|
317
|
use Carp; |
|
|
49
|
|
|
|
|
94
|
|
|
|
49
|
|
|
|
|
2922
|
|
|
180
|
49
|
|
|
49
|
|
291
|
use Net::XMPP::Connection; |
|
|
49
|
|
|
|
|
90
|
|
|
|
49
|
|
|
|
|
962
|
|
|
181
|
49
|
|
|
49
|
|
259
|
use Net::Jabber::Protocol; |
|
|
49
|
|
|
|
|
102
|
|
|
|
49
|
|
|
|
|
1307
|
|
|
182
|
49
|
|
|
49
|
|
610
|
use base qw( Net::XMPP::Connection Net::Jabber::Protocol ); |
|
|
49
|
|
|
|
|
107
|
|
|
|
49
|
|
|
|
|
5880
|
|
|
183
|
49
|
|
|
49
|
|
297
|
use vars qw( $VERSION ); |
|
|
49
|
|
|
|
|
147
|
|
|
|
49
|
|
|
|
|
3377
|
|
|
184
|
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
$VERSION = "2.0"; |
|
186
|
|
|
|
|
|
|
|
|
187
|
49
|
|
|
49
|
|
52357
|
use Net::Jabber::XDB; |
|
|
49
|
|
|
|
|
242
|
|
|
|
49
|
|
|
|
|
25862
|
|
|
188
|
|
|
|
|
|
|
|
|
189
|
|
|
|
|
|
|
sub new |
|
190
|
|
|
|
|
|
|
{ |
|
191
|
0
|
|
|
0
|
0
|
|
srand( time() ^ ($$ + ($$ << 15))); |
|
192
|
|
|
|
|
|
|
|
|
193
|
0
|
|
|
|
|
|
my $proto = shift; |
|
194
|
0
|
|
|
|
|
|
my $self = { }; |
|
195
|
|
|
|
|
|
|
|
|
196
|
0
|
|
|
|
|
|
bless($self, $proto); |
|
197
|
0
|
|
|
|
|
|
$self->init(@_); |
|
198
|
|
|
|
|
|
|
|
|
199
|
0
|
|
|
|
|
|
$self->{SERVER}->{port} = 5269; |
|
200
|
0
|
|
|
|
|
|
$self->{SERVER}->{namespace} = "jabber:component:accept"; |
|
201
|
0
|
|
|
|
|
|
$self->{SERVER}->{allow_register} = 0; |
|
202
|
|
|
|
|
|
|
|
|
203
|
0
|
|
|
|
|
|
return $self; |
|
204
|
|
|
|
|
|
|
} |
|
205
|
|
|
|
|
|
|
|
|
206
|
|
|
|
|
|
|
|
|
207
|
|
|
|
|
|
|
sub AuthSend |
|
208
|
|
|
|
|
|
|
{ |
|
209
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
|
210
|
|
|
|
|
|
|
|
|
211
|
0
|
|
|
|
|
|
$self->_auth(@_); |
|
212
|
|
|
|
|
|
|
} |
|
213
|
|
|
|
|
|
|
|
|
214
|
|
|
|
|
|
|
|
|
215
|
|
|
|
|
|
|
sub _auth |
|
216
|
|
|
|
|
|
|
{ |
|
217
|
0
|
|
|
0
|
|
|
my $self = shift; |
|
218
|
0
|
|
|
|
|
|
my (%args) = @_; |
|
219
|
|
|
|
|
|
|
|
|
220
|
0
|
|
|
|
|
|
$self->{STREAM}->SetCallBacks(node=>undef); |
|
221
|
|
|
|
|
|
|
|
|
222
|
0
|
|
|
|
|
|
$self->Send("".Digest::SHA1::sha1_hex($self->{SESSION}->{id}.$args{secret}).""); |
|
223
|
0
|
|
|
|
|
|
my $handshake = $self->Process(); |
|
224
|
|
|
|
|
|
|
|
|
225
|
0
|
0
|
0
|
|
|
|
if (!defined($handshake) || |
|
|
0
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
226
|
|
|
|
|
|
|
($#{$handshake} == -1) || |
|
227
|
|
|
|
|
|
|
(ref($handshake->[0]) ne "XML::Stream::Node") || |
|
228
|
|
|
|
|
|
|
($handshake->[0]->get_tag() ne "handshake")) |
|
229
|
|
|
|
|
|
|
{ |
|
230
|
0
|
|
|
|
|
|
$self->SetErrorCode("Bad handshake."); |
|
231
|
0
|
|
|
|
|
|
return ("fail","Bad handshake."); |
|
232
|
|
|
|
|
|
|
} |
|
233
|
0
|
|
|
|
|
|
shift(@{$handshake}); |
|
|
0
|
|
|
|
|
|
|
|
234
|
|
|
|
|
|
|
|
|
235
|
0
|
|
|
|
|
|
foreach my $node (@{$handshake}) |
|
|
0
|
|
|
|
|
|
|
|
236
|
|
|
|
|
|
|
{ |
|
237
|
0
|
|
|
|
|
|
$self->CallBack($self->{SESSION}->{id},$node); |
|
238
|
|
|
|
|
|
|
} |
|
239
|
|
|
|
|
|
|
|
|
240
|
0
|
|
|
0
|
|
|
$self->{STREAM}->SetCallBacks(node=>sub{ $self->CallBack(@_) }); |
|
|
0
|
|
|
|
|
|
|
|
241
|
|
|
|
|
|
|
|
|
242
|
0
|
|
|
|
|
|
return ("ok",""); |
|
243
|
|
|
|
|
|
|
} |
|
244
|
|
|
|
|
|
|
|
|
245
|
|
|
|
|
|
|
|
|
246
|
|
|
|
|
|
|
sub _connection_args |
|
247
|
|
|
|
|
|
|
{ |
|
248
|
0
|
|
|
0
|
|
|
my $self = shift; |
|
249
|
0
|
|
|
|
|
|
my (%args) = @_; |
|
250
|
|
|
|
|
|
|
|
|
251
|
0
|
|
|
|
|
|
my %connect; |
|
252
|
0
|
|
|
|
|
|
$connect{componentname} = $args{componentname}; |
|
253
|
0
|
|
|
|
|
|
$connect{hostname} = $args{hostname}; |
|
254
|
0
|
0
|
|
|
|
|
$connect{port} = $args{port} if exists($args{port}); |
|
255
|
0
|
0
|
|
|
|
|
$connect{connectiontype} = $args{connectiontype} if exists($args{connectiontype}); |
|
256
|
0
|
0
|
|
|
|
|
$connect{timeout} = $args{connecttimeout} if exists($args{connecttimeout}); |
|
257
|
0
|
0
|
|
|
|
|
$connect{tls} = $args{tls} if exists($args{tls}); |
|
258
|
|
|
|
|
|
|
|
|
259
|
|
|
|
|
|
|
|
|
260
|
0
|
|
|
|
|
|
return %connect; |
|
261
|
|
|
|
|
|
|
} |
|
262
|
|
|
|
|
|
|
|
|
263
|
|
|
|
|
|
|
|
|
264
|
|
|
|
|
|
|
1; |