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; |