File Coverage

blib/lib/Net/Jabber/Component.pm
Criterion Covered Total %
statement 21 59 35.5
branch 0 10 0.0
condition 0 9 0.0
subroutine 7 12 58.3
pod 0 2 0.0
total 28 92 30.4


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;