POE-Component-Jabber-3.00/ 0000755 0001750 0001750 00000000000 11161375731 015371 5 ustar nicholas nicholas POE-Component-Jabber-3.00/t/ 0000755 0001750 0001750 00000000000 11161375731 015634 5 ustar nicholas nicholas POE-Component-Jabber-3.00/t/05_j20.t 0000444 0001750 0001750 00000020122 11161375731 016713 0 ustar nicholas nicholas #!/usr/bin/perl
use warnings;
use strict;
use 5.010;
use Test::More tests => 16;
use IO::File;
use POE;
use POE::Component::Jabber;
my $file;
if(-e 'run_network_tests')
{
$file = IO::File->new('< run_network_tests');
} else {
SKIP: { skip('Network tests were declined', 16); }
exit 0;
}
my $file_config = {};
my @lines = $file->getlines();
if(!@lines)
{
SKIP: { skip('Component tests were declined', 16); }
exit 0;
}
for(0..$#lines)
{
my $i = $_;
if($lines[$_] =~ /#/)
{
$lines[$_] =~ s/#+|\s+//g;
my $hash = {};
my $subline = $lines[++$i];
do
{
chomp($subline);
my ($key, $value) = split(/=/,$subline);
$hash->{lc($key)} = lc($value);
$subline = $lines[++$i];
} while(defined($subline) && $subline !~ /#/);
$file_config->{lc($lines[$_])} = $hash;
}
}
$file->close();
undef($file);
my $config =
{
IP => $file_config->{'jabberd20'}->{'ip'},
Port => $file_config->{'jabberd20'}->{'port'},
Hostname => $file_config->{'jabberd20'}->{'host'},
Username => $file_config->{'jabberd20'}->{'user'},
Password => $file_config->{'jabberd20'}->{'secret'},
ConnectionType => +JABBERD20_COMPONENT,
debug => 0,
};
my $scratch_space = {};
POE::Session->create
(
'inline_states' =>
{
'_start' =>
sub
{
$_[KERNEL]->alias_set('j20_testing');
$config->{'Alias'} = 'pcj';
$_[HEAP]->{'pcj'} = POE::Component::Jabber->new(%$config);
$_[KERNEL]->yield('continue');
},
'continue' =>
sub
{
$_[KERNEL]->post('pcj', 'subscribe', +PCJ_CONNECT, 'pcj_connect');
$_[KERNEL]->post('pcj', 'subscribe', +PCJ_CONNECTING, 'pcj_connecting');
$_[KERNEL]->post('pcj', 'subscribe', +PCJ_CONNECTED, 'pcj_connected');
$_[KERNEL]->post('pcj', 'subscribe', +PCJ_CONNECTFAIL, 'pcj_connectfail');
$_[KERNEL]->post('pcj', 'subscribe', +PCJ_STREAMSTART, 'pcj_streamstart');
$_[KERNEL]->post('pcj', 'subscribe', +PCJ_STREAMEND, 'pcj_streamend');
$_[KERNEL]->post('pcj', 'subscribe', +PCJ_SSLNEGOTIATE, 'pcj_sslnegotiate');
$_[KERNEL]->post('pcj', 'subscribe', +PCJ_SSLSUCCESS, 'pcj_sslsuccess');
$_[KERNEL]->post('pcj', 'subscribe', +PCJ_SSLFAIL, 'pcj_sslfail');
$_[KERNEL]->post('pcj', 'subscribe', +PCJ_AUTHNEGOTIATE, 'pcj_authnegotiate');
$_[KERNEL]->post('pcj', 'subscribe', +PCJ_AUTHSUCCESS, 'pcj_authsuccess');
$_[KERNEL]->post('pcj', 'subscribe', +PCJ_AUTHFAIL, 'pcj_authfail');
$_[KERNEL]->post('pcj', 'subscribe', +PCJ_BINDNEGOTIATE, 'pcj_bindnegotiate');
$_[KERNEL]->post('pcj', 'subscribe', +PCJ_BINDSUCCESS, 'pcj_bindsuccess');
$_[KERNEL]->post('pcj', 'subscribe', +PCJ_BINDFAIL, 'pcj_bindfail');
$_[KERNEL]->post('pcj', 'subscribe', +PCJ_READY, 'pcj_ready');
$_[KERNEL]->post('pcj', 'subscribe', +PCJ_SHUTDOWN_START, 'pcj_shutdown_start');
$_[KERNEL]->post('pcj', 'subscribe', +PCJ_SHUTDOWN_FINISH, 'pcj_shutdown_finish');
$_[KERNEL]->post('pcj', 'subscribe', +PCJ_SOCKETFAIL, 'pcj_socketfail');
$_[KERNEL]->post('pcj', 'subscribe', +PCJ_SOCKETDISCONNECT, 'pcj_socketdisconnect');
$_[KERNEL]->post('pcj', 'subscribe', +PCJ_NODERECEIVED, 'pcj_nodereceived');
$_[KERNEL]->post('pcj', 'subscribe', +PCJ_NODESENT, 'pcj_nodesent');
if(-e 'run_network_tests')
{
$_[KERNEL]->post('pcj', 'connect');
} else {
SKIP: { skip('Network tests were declined', 16); }
exit 0;
}
},
'pcj_nodesent' =>
sub
{
my ($kernel, $arg) = @_[KERNEL, ARG0];
if($config->{'debug'})
{
say $arg->toString();
}
},
'pcj_nodereceived' =>
sub
{
my ($kernel, $arg) = @_[KERNEL, ARG0];
if($config->{'debug'})
{
say $arg->toString();
}
},
'pcj_connect' =>
sub
{
pass('Connect started');
},
'pcj_connecting' =>
sub
{
pass('Connecting');
},
'pcj_connected' =>
sub
{
pass('Connection sucessful');
},
'pcj_connectfail' =>
sub
{
BAIL_OUT(q|We couldn't connect to the server. Check your |.
'network connection or rerun Build.PL and say "N" to '.
'network enabled tests');
},
'pcj_streamstart' =>
sub
{
pass('Stream initated');
},
'pcj_streamend' =>
sub
{
$scratch_space->{'STEAMEND'} = 1;
pass('Stream end sent');
},
'pcj_sslnegotiate' =>
sub
{
pass('Negotiating SSL/TLS');
},
'pcj_sslsuccess' =>
sub
{
pass('SSL/TLS sucessfully negotiated');
},
'pcj_sslfail' =>
sub
{
BAIL_OUT('SSL failed for some reason. Since this is, '.
'for the most part, a dynamic/automatic process, '.
'there may be a problem with the server.');
},
'pcj_authnegotiate' =>
sub
{
pass('Negotiating authentication');
},
'pcj_authsuccess' =>
sub
{
pass('Authentication sucessfully negotiated');
},
'pcj_authfail' =>
sub
{
BAIL_OUT('Authentication failed for some reason. ' .
'Please check the username and password in this test '.
'to make sure it is correct.');
},
'pcj_bindnegotiate' =>
sub
{
pass('Negotiating bind');
},
'pcj_bindsuccess' =>
sub
{
$scratch_space->{'BIND'} = 1;
pass('Bind successfully negotiated');
},
'pcj_bindfail' =>
sub
{
BAIL_OUT('Binding failed for some reason. Since this is, '.
'for the most part, a dynamic/automatic process, '.
'there may be a problem with the server.');
},
'pcj_ready' =>
sub
{
pass('PCJ initialization complete');
$_[KERNEL]->post('pcj', 'shutdown');
},
'pcj_shutdown_start' =>
sub
{
if(!defined($scratch_space->{'STEAMEND'}))
{
fail('A stream end was not sent to the server!');
} else {
$scratch_space->{'SHUTDOWNSTART'} = 1;
pass('Shutdown in progress');
}
},
'pcj_shutdown_finish' =>
sub
{
if(!defined($scratch_space->{'SHUTDOWNSTART'}))
{
fail('Shutdown start was never called');
} else {
pass('Shutdown complete');
}
},
'pcj_socketfail' =>
sub
{
if(!defined($scratch_space->{'STEAMEND'}))
{
BAIL_OUT('There was a socket failure during testing');
} else {
pass('Socket read error at end of stream okay');
}
},
'pcj_socketdisconnect' =>
sub
{
if(!defined($scratch_space->{'SHUTDOWNSTART'}))
{
BAIL_OUT('We were disconnected during testing');
} else {
pass('Disconnected called at the right time');
}
},
}
);
POE::Kernel->run();
exit 0;
POE-Component-Jabber-3.00/t/01_basic.t 0000444 0001750 0001750 00000010370 11161375731 017401 0 ustar nicholas nicholas #!/usr/bin/perl
use warnings;
use strict;
use Test::More tests => 29;
use POE;
BEGIN
{
use_ok('POE::Component::Jabber');
use_ok('POE::Component::Jabber::Events');
use_ok('POE::Component::Jabber::ProtocolFactory');
}
sub test_new_pcj_fail
{
my ($name, @args) = @_;
eval { POE::Component::Jabber->new(@args); };
ok($@ ne '', $name);
}
sub test_new_pcj_succeed
{
my ($name, @args) = @_;
eval { POE::Component::Jabber->new(@args); };
ok($@ eq '', $name);
}
# Lets start by testing constants
can_ok('POE::Component::Jabber::Events',
qw/ PCJ_CONNECT PCJ_CONNECTING PCJ_CONNECTED PCJ_STREAMSTART
PCJ_SSLNEGOTIATE PCJ_SSLSUCCESS PCJ_AUTHNEGOTIATE PCJ_AUTHSUCCESS
PCJ_BINDNEGOTIATE PCJ_BINDSUCCESS PCJ_SESSIONNEGOTIATE PCJ_SESSIONSUCCESS
PCJ_NODESENT PCJ_NODERECEIVED PCJ_NODEQUEUED PCJ_RTS_START
PCJ_RTS_FINISH PCJ_READY PCJ_STREAMEND PCJ_SHUTDOWN_START
PCJ_SHUTDOWN_FINISH PCJ_SOCKETFAIL PCJ_SOCKETDISCONNECT PCJ_AUTHFAIL
PCJ_BINDFAIL PCJ_SESSIONFAIL PCJ_SSLFAIL PCJ_CONNECTFAIL/);
can_ok('POE::Component::Jabber::ProtocolFactory',
qw/ JABBERD14_COMPONENT JABBERD20_COMPONENT LEGACY XMPP /);
#now lets test ProtocolFactory
my $guts = POE::Component::Jabber::ProtocolFactory::get_guts(+XMPP);
isa_ok($guts, 'POE::Component::Jabber::XMPP');
isa_ok($guts, 'POE::Component::Jabber::Protocol');
$guts = POE::Component::Jabber::ProtocolFactory::get_guts(+LEGACY);
isa_ok($guts, 'POE::Component::Jabber::Legacy');
isa_ok($guts, 'POE::Component::Jabber::Protocol');
$guts = POE::Component::Jabber::ProtocolFactory::get_guts(+JABBERD14_COMPONENT);
isa_ok($guts, 'POE::Component::Jabber::J14');
isa_ok($guts, 'POE::Component::Jabber::Protocol');
$guts = POE::Component::Jabber::ProtocolFactory::get_guts(+JABBERD20_COMPONENT);
isa_ok($guts, 'POE::Component::Jabber::J2');
isa_ok($guts, 'POE::Component::Jabber::Protocol');
#now lets test constructing PCJ
my $config =
{
IP => 'jabber.org',
Port => '5222',
Hostname => 'jabber.org',
Username => 'PCJTester',
Password => 'PCJTester',
ConnectionType => +XMPP,
};
my $scratch_space = {};
POE::Session->create
(
'inline_states' =>
{
'_start' =>
sub
{
$_[KERNEL]->alias_set('basic_testing');
$_[KERNEL]->yield('continue');
$_[HEAP] = $config;
},
'continue' =>
sub
{
test_new_pcj_fail('No arguments');
my @keys = keys(%{$_[HEAP]});
foreach my $key (@keys)
{
my %hash = %{$_[HEAP]};
delete($hash{$key});
test_new_pcj_fail('No ' . $key, %hash);
}
$_[HEAP]->{'Alias'} = 'PCJ_TESTER';
$_[HEAP]->{'ConnectionType'} = 12983;
test_new_pcj_fail('Invalid ConnectionType', %{$_[HEAP]});
$_[KERNEL]->yield('xmpp');
},
'xmpp' =>
sub
{
$_[HEAP]->{'ConnectionType'} = +XMPP;
test_new_pcj_succeed('Correct construction XMPP', %{$_[HEAP]});
$_[KERNEL]->call('PCJ_TESTER', 'destroy');
$_[KERNEL]->yield('legacy');
},
'legacy' =>
sub
{
ok(!$_[KERNEL]->post('PCJ_TESTER'), 'XMPP component destroyed');
$_[HEAP]->{'ConnectionType'} = +LEGACY;
test_new_pcj_succeed('Correct construction LEGACY', %{$_[HEAP]});
$_[KERNEL]->call('PCJ_TESTER', 'destroy');
$_[KERNEL]->yield('j14');
},
'j14' =>
sub
{
ok(!$_[KERNEL]->post('PCJ_TESTER'), 'LEGACY component destroyed');
$_[HEAP]->{'ConnectionType'} = +JABBERD14_COMPONENT;
test_new_pcj_succeed('Correct construction J14', %{$_[HEAP]});
$_[KERNEL]->call('PCJ_TESTER', 'destroy');
$_[KERNEL]->yield('j20');
},
'j20' =>
sub
{
ok(!$_[KERNEL]->post('PCJ_TESTER'), 'J14 component destroyed');
$_[HEAP]->{'ConnectionType'} = +JABBERD20_COMPONENT;
test_new_pcj_succeed('Correct construction J2', %{$_[HEAP]});
$_[KERNEL]->call('PCJ_TESTER', 'destroy');
$_[KERNEL]->yield('destroyed');
},
'destroyed' =>
sub
{
ok(!$_[KERNEL]->post('PCJ_TESTER'), 'J20 component destroyed');
},
}
);
POE::Kernel->run();
exit 0;
POE-Component-Jabber-3.00/t/02_xmpp.t 0000444 0001750 0001750 00000024341 11161375731 017310 0 ustar nicholas nicholas #!/usr/bin/perl
use warnings;
use strict;
use 5.010;
use Test::More tests => 25;
use POE;
use POE::Component::Jabber;
my $config =
{
IP => 'jabber.org',
Port => '5222',
Hostname => 'jabber.org',
Username => 'poecomponentjabber',
Password => 'poecomponentjabber',
ConnectionType => +XMPP,
debug => 0,
};
my $scratch_space = {};
POE::Session->create
(
'inline_states' =>
{
'_start' =>
sub
{
$_[KERNEL]->alias_set('xmpp_testing');
$config->{'Alias'} = 'pcj';
$_[HEAP]->{'pcj'} = POE::Component::Jabber->new(%$config);
$_[KERNEL]->yield('continue');
},
'continue' =>
sub
{
$_[KERNEL]->post('pcj', 'subscribe', +PCJ_CONNECT, 'pcj_connect');
$_[KERNEL]->post('pcj', 'subscribe', +PCJ_CONNECTING, 'pcj_connecting');
$_[KERNEL]->post('pcj', 'subscribe', +PCJ_CONNECTED, 'pcj_connected');
$_[KERNEL]->post('pcj', 'subscribe', +PCJ_CONNECTFAIL, 'pcj_connectfail');
$_[KERNEL]->post('pcj', 'subscribe', +PCJ_STREAMSTART, 'pcj_streamstart');
$_[KERNEL]->post('pcj', 'subscribe', +PCJ_STREAMEND, 'pcj_streamend');
$_[KERNEL]->post('pcj', 'subscribe', +PCJ_SSLNEGOTIATE, 'pcj_sslnegotiate');
$_[KERNEL]->post('pcj', 'subscribe', +PCJ_SSLSUCCESS, 'pcj_sslsuccess');
$_[KERNEL]->post('pcj', 'subscribe', +PCJ_SSLFAIL, 'pcj_sslfail');
$_[KERNEL]->post('pcj', 'subscribe', +PCJ_AUTHNEGOTIATE, 'pcj_authnegotiate');
$_[KERNEL]->post('pcj', 'subscribe', +PCJ_AUTHSUCCESS, 'pcj_authsuccess');
$_[KERNEL]->post('pcj', 'subscribe', +PCJ_AUTHFAIL, 'pcj_authfail');
$_[KERNEL]->post('pcj', 'subscribe', +PCJ_BINDNEGOTIATE, 'pcj_bindnegotiate');
$_[KERNEL]->post('pcj', 'subscribe', +PCJ_BINDSUCCESS, 'pcj_bindsuccess');
$_[KERNEL]->post('pcj', 'subscribe', +PCJ_BINDFAIL, 'pcj_bindfail');
$_[KERNEL]->post('pcj', 'subscribe', +PCJ_SESSIONNEGOTIATE, 'pcj_sessionnegotiate');
$_[KERNEL]->post('pcj', 'subscribe', +PCJ_SESSIONSUCCESS, 'pcj_sessionsuccess');
$_[KERNEL]->post('pcj', 'subscribe', +PCJ_SESSIONFAIL, 'pcj_sessionfail');
$_[KERNEL]->post('pcj', 'subscribe', +PCJ_READY, 'pcj_ready');
$_[KERNEL]->post('pcj', 'subscribe', +PCJ_SHUTDOWN_START, 'pcj_shutdown_start');
$_[KERNEL]->post('pcj', 'subscribe', +PCJ_SHUTDOWN_FINISH, 'pcj_shutdown_finish');
$_[KERNEL]->post('pcj', 'subscribe', +PCJ_SOCKETFAIL, 'pcj_socketfail');
$_[KERNEL]->post('pcj', 'subscribe', +PCJ_SOCKETDISCONNECT, 'pcj_socketdisconnect');
$_[KERNEL]->post('pcj', 'subscribe', +PCJ_NODERECEIVED, 'pcj_nodereceived');
$_[KERNEL]->post('pcj', 'subscribe', +PCJ_NODESENT, 'pcj_nodesent');
$_[KERNEL]->post('pcj', 'subscribe', 'pcj_xpathfilter', 'pcj_xpathfilter');
$_[KERNEL]->post('pcj', 'xpath_filter', 'add', 'pcj_xpathfilter', q/self::node()[@id='FILTER_TEST']|child::*[@id='FILTER_TEST']/);
if(-e 'run_network_tests')
{
$_[KERNEL]->post('pcj', 'connect');
} else {
SKIP: { skip('Network tests were declined', 25); }
exit 0;
}
},
'pcj_nodesent' =>
sub
{
my ($kernel, $arg) = @_[KERNEL, ARG0];
if($config->{'debug'})
{
say $arg->toString();
}
},
'pcj_nodereceived' =>
sub
{
my ($kernel, $arg) = @_[KERNEL, ARG0];
if($config->{'debug'})
{
say $arg->toString();
}
},
'pcj_connect' =>
sub
{
pass('Connect started');
},
'pcj_connecting' =>
sub
{
pass('Connecting');
},
'pcj_connected' =>
sub
{
pass('Connection sucessful');
},
'pcj_connectfail' =>
sub
{
BAIL_OUT(q|We couldn't connect to the server. Check your |.
'network connection or rerun Build.PL and say "N" to '.
'network enabled tests');
},
'pcj_streamstart' =>
sub
{
pass('Stream initated');
},
'pcj_streamend' =>
sub
{
$scratch_space->{'STEAMEND'} = 1;
pass('Stream end sent');
},
'pcj_sslnegotiate' =>
sub
{
pass('Negotiating SSL/TLS');
},
'pcj_sslsuccess' =>
sub
{
pass('SSL/TLS sucessfully negotiated');
},
'pcj_sslfail' =>
sub
{
BAIL_OUT('Session failed for some reason. Since this is, '.
'for the most part, a dynamic/automatic process, '.
'there may be a problem with the server.');
},
'pcj_authnegotiate' =>
sub
{
pass('Negotiating authentication');
},
'pcj_authsuccess' =>
sub
{
pass('Authentication sucessfully negotiated');
},
'pcj_authfail' =>
sub
{
BAIL_OUT('Authentication failed for some reason. ' .
'Please check the username and password in this test '.
'to make sure it is correct.');
},
'pcj_bindnegotiate' =>
sub
{
pass('Negotiating bind');
},
'pcj_bindsuccess' =>
sub
{
$scratch_space->{'BIND'} = 1;
pass('Bind successfully negotiated');
},
'pcj_bindfail' =>
sub
{
BAIL_OUT('Binding failed for some reason. Since this is, '.
'for the most part, a dynamic/automatic process, '.
'there may be a problem with the server.');
},
'pcj_sessionnegotiate' =>
sub
{
pass('Negotiating session');
},
'pcj_sessionsuccess' =>
sub
{
$scratch_space->{'SESSION'} = 1;
pass('Session successfully negotiated');
},
'pcj_sessionfail' =>
sub
{
BAIL_OUT('Session failed for some reason. Since this is, '.
'for the most part, a dynamic/automatic process, '.
'there may be a problem with the server.');
},
'pcj_ready' =>
sub
{
if(!defined($scratch_space->{'BIND'}))
{
SKIP:
{
skip('Binding negotiation not asked for', 2);
}
if(defined($scratch_space->{'SESSION'}))
{
fail('Inconsistent state for compliant protocol '.
'implementation');
BAIL_OUT('The test server is really wonky or PCJ '.
'is horribly broken. Please submit an rt '.
'ticket ASAP');
}
}
if(!defined($scratch_space->{'SESSION'}))
{
SKIP:
{
skip('Session negotiation not asked for', 2);
}
}
pass('PCJ initialization complete');
my $node = POE::Filter::XML::Node->new
(
'iq',
[
'to', sprintf('%s@%s', $config->{'Username'}, $config->{'Hostname'}),
'id', 'FILTER_TEST'
]
);
$_[KERNEL]->post('pcj', 'output', $node);
},
'pcj_shutdown_start' =>
sub
{
if(!defined($scratch_space->{'STEAMEND'}))
{
fail('A stream end was not sent to the server!');
} else {
$scratch_space->{'SHUTDOWNSTART'} = 1;
pass('Shutdown in progress');
}
},
'pcj_shutdown_finish' =>
sub
{
if(!defined($scratch_space->{'SHUTDOWNSTART'}))
{
fail('Shutdown start was never called');
} else {
pass('Shutdown complete');
}
},
'pcj_xpathfilter' =>
sub
{
my ($kernel, $expr, $found_nodes, $input) =
@_[KERNEL, ARG0..ARG2];
ok($expr eq q/self::node()[@id='FILTER_TEST']|child::*[@id='FILTER_TEST']/, 'XPATH expression');
is(scalar(@$found_nodes), 1, 'One node returned from xpath expression');
isa_ok($found_nodes->[0], 'POE::Filter::XML::Node');
isa_ok($input, 'POE::Filter::XML::Node');
is($found_nodes->[0]->toString(), $input->toString(), 'Found node matches the input node');
$kernel->post('pcj', 'shutdown');
},
'pcj_socketfail' =>
sub
{
if(!defined($scratch_space->{'STEAMEND'}))
{
BAIL_OUT('There was a socket failure during testing');
} else {
pass('Socket read error at end of stream okay');
}
},
'pcj_socketdisconnect' =>
sub
{
if(!defined($scratch_space->{'SHUTDOWNSTART'}))
{
BAIL_OUT('We were disconnected during testing');
} else {
pass('Disconnected called at the right time');
}
},
}
);
POE::Kernel->run();
exit 0;
POE-Component-Jabber-3.00/t/03_legacy.t 0000444 0001750 0001750 00000015477 11161375731 017603 0 ustar nicholas nicholas #!/usr/bin/perl
use warnings;
use strict;
use 5.010;
use Test::More tests => 16;
use POE;
use POE::Component::Jabber;
my $config =
{
IP => 'jabber.org',
Port => '5222',
Hostname => 'jabber.org',
Username => 'poecomponentjabber',
Password => 'poecomponentjabber',
ConnectionType => +LEGACY,
debug => 0,
};
my $scratch_space = {};
POE::Session->create
(
'inline_states' =>
{
'_start' =>
sub
{
$_[KERNEL]->alias_set('xmpp_testing');
$config->{'Alias'} = 'pcj';
$_[HEAP]->{'pcj'} = POE::Component::Jabber->new(%$config);
$_[KERNEL]->yield('continue');
},
'continue' =>
sub
{
$_[KERNEL]->post('pcj', 'subscribe', +PCJ_CONNECT, 'pcj_connect');
$_[KERNEL]->post('pcj', 'subscribe', +PCJ_CONNECTING, 'pcj_connecting');
$_[KERNEL]->post('pcj', 'subscribe', +PCJ_CONNECTED, 'pcj_connected');
$_[KERNEL]->post('pcj', 'subscribe', +PCJ_CONNECTFAIL, 'pcj_connectfail');
$_[KERNEL]->post('pcj', 'subscribe', +PCJ_STREAMSTART, 'pcj_streamstart');
$_[KERNEL]->post('pcj', 'subscribe', +PCJ_STREAMEND, 'pcj_streamend');
$_[KERNEL]->post('pcj', 'subscribe', +PCJ_AUTHNEGOTIATE, 'pcj_authnegotiate');
$_[KERNEL]->post('pcj', 'subscribe', +PCJ_AUTHSUCCESS, 'pcj_authsuccess');
$_[KERNEL]->post('pcj', 'subscribe', +PCJ_AUTHFAIL, 'pcj_authfail');
$_[KERNEL]->post('pcj', 'subscribe', +PCJ_READY, 'pcj_ready');
$_[KERNEL]->post('pcj', 'subscribe', +PCJ_SHUTDOWN_START, 'pcj_shutdown_start');
$_[KERNEL]->post('pcj', 'subscribe', +PCJ_SHUTDOWN_FINISH, 'pcj_shutdown_finish');
$_[KERNEL]->post('pcj', 'subscribe', +PCJ_SOCKETFAIL, 'pcj_socketfail');
$_[KERNEL]->post('pcj', 'subscribe', +PCJ_SOCKETDISCONNECT, 'pcj_socketdisconnect');
$_[KERNEL]->post('pcj', 'subscribe', +PCJ_NODERECEIVED, 'pcj_nodereceived');
$_[KERNEL]->post('pcj', 'subscribe', +PCJ_NODESENT, 'pcj_nodesent');
$_[KERNEL]->post('pcj', 'subscribe', 'pcj_xpathfilter', 'pcj_xpathfilter');
$_[KERNEL]->post('pcj', 'xpath_filter', 'add', 'pcj_xpathfilter', q/self::node()[@id='FILTER_TEST']|child::*[@id='FILTER_TEST']/);
if(-e 'run_network_tests')
{
$_[KERNEL]->post('pcj', 'connect');
} else {
SKIP: { skip('Network tests were declined', 16); }
exit 0;
}
},
'pcj_nodesent' =>
sub
{
my ($kernel, $arg) = @_[KERNEL, ARG0];
if($config->{'debug'})
{
say $arg->toString();
}
},
'pcj_nodereceived' =>
sub
{
my ($kernel, $arg) = @_[KERNEL, ARG0];
if($config->{'debug'})
{
say $arg->toString();
}
},
'pcj_connect' =>
sub
{
pass('Connect started');
},
'pcj_connecting' =>
sub
{
pass('Connecting');
},
'pcj_connected' =>
sub
{
pass('Connection sucessful');
},
'pcj_connectfail' =>
sub
{
BAIL_OUT(q|We couldn't connect to the server. Check your |.
'network connection or rerun Build.PL and say "N" to '.
'network enabled tests');
},
'pcj_streamstart' =>
sub
{
pass('Stream initated');
},
'pcj_streamend' =>
sub
{
$scratch_space->{'STEAMEND'} = 1;
pass('Stream end sent');
},
'pcj_authnegotiate' =>
sub
{
pass('Negotiating authentication');
},
'pcj_authsuccess' =>
sub
{
pass('Authentication sucessfully negotiated');
},
'pcj_authfail' =>
sub
{
BAIL_OUT('Authentication failed for some reason. ' .
'Please check the username and password in this test '.
'to make sure it is correct.');
},
'pcj_ready' =>
sub
{
my $node = POE::Filter::XML::Node->new
(
'iq',
[
'to', sprintf('%s@%s', $config->{'Username'}, $config->{'Hostname'}),
'id', 'FILTER_TEST'
]
);
$_[KERNEL]->post('pcj', 'output', $node);
},
'pcj_shutdown_start' =>
sub
{
if(!defined($scratch_space->{'STEAMEND'}))
{
fail('A stream end was not sent to the server!');
} else {
$scratch_space->{'SHUTDOWNSTART'} = 1;
pass('Shutdown in progress');
}
},
'pcj_shutdown_finish' =>
sub
{
if(!defined($scratch_space->{'SHUTDOWNSTART'}))
{
fail('Shutdown start was never called');
} else {
pass('Shutdown complete');
}
},
'pcj_xpathfilter' =>
sub
{
my ($kernel, $expr, $found_nodes, $input) =
@_[KERNEL, ARG0..ARG2];
ok($expr eq q/self::node()[@id='FILTER_TEST']|child::*[@id='FILTER_TEST']/, 'XPATH expression');
is(scalar(@$found_nodes), 1, 'One node returned from xpath expression');
isa_ok($found_nodes->[0], 'POE::Filter::XML::Node');
isa_ok($input, 'POE::Filter::XML::Node');
is($found_nodes->[0]->toString(), $input->toString(), 'Found node matches the input node');
$kernel->post('pcj', 'shutdown');
},
'pcj_socketfail' =>
sub
{
if(!defined($scratch_space->{'STEAMEND'}))
{
BAIL_OUT('There was a socket failure during testing');
} else {
pass('Socket read error at end of stream okay');
}
},
'pcj_socketdisconnect' =>
sub
{
if(!defined($scratch_space->{'SHUTDOWNSTART'}))
{
BAIL_OUT('We were disconnected during testing');
} else {
pass('Disconnected called at the right time');
}
},
}
);
POE::Kernel->run();
exit 0;
POE-Component-Jabber-3.00/t/04_j14.t 0000444 0001750 0001750 00000014644 11161375731 016731 0 ustar nicholas nicholas #!/usr/bin/perl
use warnings;
use strict;
use 5.010;
use Test::More tests => 11;
use IO::File;
use POE;
use POE::Component::Jabber;
my $file;
if(-e 'run_network_tests')
{
$file = IO::File->new('< run_network_tests');
} else {
SKIP: { skip('Network tests were declined', 11); }
exit 0;
}
my $file_config = {};
my @lines = $file->getlines();
if(!@lines)
{
SKIP: { skip('Component tests were declined', 11); }
exit 0;
}
for(0..$#lines)
{
my $i = $_;
if($lines[$_] =~ /#/i)
{
$lines[$_] =~ s/#+|\s+//g;
my $hash = {};
my $subline = $lines[++$i];
do
{
chomp($subline);
my ($key, $value) = split(/=/,$subline);
$hash->{lc($key)} = lc($value);
$subline = $lines[++$i];
} while(defined($subline) && $subline !~ /#/);
$file_config->{lc($lines[$_])} = $hash;
}
}
$file->close();
undef($file);
my $config =
{
IP => $file_config->{'jabberd14'}->{'ip'},
Port => $file_config->{'jabberd14'}->{'port'},
Hostname => $file_config->{'jabberd14'}->{'host'},
Username => 'jabberd',
Password => $file_config->{'jabberd14'}->{'secret'},
ConnectionType => +JABBERD14_COMPONENT,
debug => 0,
};
my $scratch_space = {};
POE::Session->create
(
'inline_states' =>
{
'_start' =>
sub
{
$_[KERNEL]->alias_set('xmpp_testing');
$config->{'Alias'} = 'pcj';
$_[HEAP]->{'pcj'} = POE::Component::Jabber->new(%$config);
$_[KERNEL]->yield('continue');
},
'continue' =>
sub
{
$_[KERNEL]->post('pcj', 'subscribe', +PCJ_CONNECT, 'pcj_connect');
$_[KERNEL]->post('pcj', 'subscribe', +PCJ_CONNECTING, 'pcj_connecting');
$_[KERNEL]->post('pcj', 'subscribe', +PCJ_CONNECTED, 'pcj_connected');
$_[KERNEL]->post('pcj', 'subscribe', +PCJ_CONNECTFAIL, 'pcj_connectfail');
$_[KERNEL]->post('pcj', 'subscribe', +PCJ_STREAMSTART, 'pcj_streamstart');
$_[KERNEL]->post('pcj', 'subscribe', +PCJ_STREAMEND, 'pcj_streamend');
$_[KERNEL]->post('pcj', 'subscribe', +PCJ_AUTHNEGOTIATE, 'pcj_authnegotiate');
$_[KERNEL]->post('pcj', 'subscribe', +PCJ_AUTHSUCCESS, 'pcj_authsuccess');
$_[KERNEL]->post('pcj', 'subscribe', +PCJ_AUTHFAIL, 'pcj_authfail');
$_[KERNEL]->post('pcj', 'subscribe', +PCJ_READY, 'pcj_ready');
$_[KERNEL]->post('pcj', 'subscribe', +PCJ_SHUTDOWN_START, 'pcj_shutdown_start');
$_[KERNEL]->post('pcj', 'subscribe', +PCJ_SHUTDOWN_FINISH, 'pcj_shutdown_finish');
$_[KERNEL]->post('pcj', 'subscribe', +PCJ_SOCKETFAIL, 'pcj_socketfail');
$_[KERNEL]->post('pcj', 'subscribe', +PCJ_SOCKETDISCONNECT, 'pcj_socketdisconnect');
$_[KERNEL]->post('pcj', 'subscribe', +PCJ_NODERECEIVED, 'pcj_nodereceived');
$_[KERNEL]->post('pcj', 'subscribe', +PCJ_NODESENT, 'pcj_nodesent');
if(-e 'run_network_tests')
{
$_[KERNEL]->post('pcj', 'connect');
} else {
SKIP: { skip('Network tests were declined', 11); }
exit 0;
}
},
'pcj_nodesent' =>
sub
{
my ($kernel, $arg) = @_[KERNEL, ARG0];
if($config->{'debug'})
{
say $arg->toString();
}
},
'pcj_nodereceived' =>
sub
{
my ($kernel, $arg) = @_[KERNEL, ARG0];
if($config->{'debug'})
{
say $arg->toString();
}
},
'pcj_connect' =>
sub
{
pass('Connect started');
},
'pcj_connecting' =>
sub
{
pass('Connecting');
},
'pcj_connected' =>
sub
{
pass('Connection sucessful');
},
'pcj_connectfail' =>
sub
{
BAIL_OUT(q|We couldn't connect to the server. Check your |.
'network connection or rerun Build.PL and say "N" to '.
'network enabled tests');
},
'pcj_streamstart' =>
sub
{
pass('Stream initated');
},
'pcj_streamend' =>
sub
{
$scratch_space->{'STEAMEND'} = 1;
pass('Stream end sent');
},
'pcj_authnegotiate' =>
sub
{
pass('Negotiating authentication');
},
'pcj_authsuccess' =>
sub
{
pass('Authentication sucessfully negotiated');
},
'pcj_authfail' =>
sub
{
BAIL_OUT('Authentication failed for some reason. ' .
'Please check the username and password in this test '.
'to make sure it is correct.');
},
'pcj_ready' =>
sub
{
$_[KERNEL]->post('pcj', 'shutdown');
},
'pcj_shutdown_start' =>
sub
{
if(!defined($scratch_space->{'STEAMEND'}))
{
fail('A stream end was not sent to the server!');
} else {
$scratch_space->{'SHUTDOWNSTART'} = 1;
pass('Shutdown in progress');
}
},
'pcj_shutdown_finish' =>
sub
{
if(!defined($scratch_space->{'SHUTDOWNSTART'}))
{
fail('Shutdown start was never called');
} else {
pass('Shutdown complete');
}
},
'pcj_socketfail' =>
sub
{
if(!defined($scratch_space->{'STEAMEND'}))
{
BAIL_OUT('There was a socket failure during testing');
} else {
pass('Socket read error at end of stream okay');
}
},
'pcj_socketdisconnect' =>
sub
{
if(!defined($scratch_space->{'SHUTDOWNSTART'}))
{
BAIL_OUT('We were disconnected during testing');
} else {
pass('Disconnected called at the right time');
}
},
}
);
POE::Kernel->run();
exit 0;
POE-Component-Jabber-3.00/lib/ 0000755 0001750 0001750 00000000000 11161375731 016137 5 ustar nicholas nicholas POE-Component-Jabber-3.00/lib/POE/ 0000755 0001750 0001750 00000000000 11161375731 016562 5 ustar nicholas nicholas POE-Component-Jabber-3.00/lib/POE/Component/ 0000755 0001750 0001750 00000000000 11161375731 020524 5 ustar nicholas nicholas POE-Component-Jabber-3.00/lib/POE/Component/Jabber/ 0000755 0001750 0001750 00000000000 11161375731 021711 5 ustar nicholas nicholas POE-Component-Jabber-3.00/lib/POE/Component/Jabber/J14.pm 0000444 0001750 0001750 00000005771 11161375731 022615 0 ustar nicholas nicholas package POE::Component::Jabber::J14;
use warnings;
use strict;
use 5.010;
use POE;
use POE::Component::Jabber::Events;
use POE::Filter::XML;
use POE::Filter::XML::Node;
use POE::Filter::XML::NS qw/ :JABBER :IQ /;
use Digest::SHA1 qw/ sha1_hex /;
use base('POE::Component::Jabber::Protocol');
our $VERSION = '3.00';
sub get_version()
{
return '0.9';
}
sub get_xmlns()
{
return +NS_JABBER_ACCEPT;
}
sub get_states()
{
return [ 'set_auth', 'init_input_handler' ];
}
sub get_input_event()
{
return 'init_input_handler';
}
sub set_auth()
{
my ($kernel, $heap, $self) = @_[KERNEL, HEAP, OBJECT];
my $node = POE::Filter::XML::Node->new('handshake');
my $config = $heap->config();
$node->appendText(sha1_hex($self->{'sid'}.$config->{'password'}));
$kernel->post($heap->events(), +PCJ_AUTHNEGOTIATE);
$kernel->yield('output_handler', $node, 1);
return;
}
sub init_input_handler()
{
my ($kernel, $heap, $self, $node) = @_[KERNEL, HEAP, OBJECT, ARG0];
given($node->nodeName())
{
when('handshake')
{
my $config = $heap->config();
$kernel->post($heap->events(), +PCJ_AUTHSUCCESS);
$kernel->post($heap->events(), +PCJ_READY);
$heap->jid($config->{'hostname'});
$heap->relinquish_states();
}
when('stream:stream')
{
$self->{'sid'} = $node->getAttribute('id');
$kernel->yield('set_auth');
}
default
{
$heap->debug_message('Unknown state: ' . $node->toString());
$kernel->post($heap->events(), +PCJ_AUTHFAIL);
}
}
}
1;
__END__
=pod
=head1 NAME
POE::Component::Jabber::J14
=head1 SYNOPSIS
PCJ::J14 is a Protocol implementation that connects as a service to a jabberd14
server.
=head1 DESCRIPTION
PCJ::J14 authenticates with the server backend using the method outlined in
XEP-114 (Jabber Component Protocol)
[http://www.xmpp.org/extensions/xep-0114.html]
=head1 METHODS
Please see PCJ::Protocol for what methods this class supports.
=head1 EVENTS
Listed below are the exported events that end up in PCJ's main session:
=over 2
=item set_auth
This event constructs and sends the element for authentication.
=item init_input_handler
This is out main entry point that PCJ uses to send us all of the input. It
handles the authentication response.
=back
=head1 NOTES AND BUGS
This only implements the jabber:component:accept namespace (ie. the component
initiates the connection to the server).
Also be aware that before this protocol was documented as an XEP, it was widely
implemented with loose rules. I conform to this document. If there is a problem
with the implementation against older server implementations, let me know.
The underlying backend has changed this release to now use a new Node
implementation based on XML::LibXML::Element. Please see POE::Filter::XML::Node
documentation for the relevant API changes.
=head1 AUTHOR
Copyright (c) 2003-2009 Nicholas Perez. Distributed under the GPL.
=cut
POE-Component-Jabber-3.00/lib/POE/Component/Jabber/Events.pm 0000444 0001750 0001750 00000014060 11161375731 023512 0 ustar nicholas nicholas package POE::Component::Jabber::Events;
use warnings;
use strict;
use constant
{
'PCJ_CONNECT' => 'PCJ_CONNECT',
'PCJ_CONNECTING' => 'PCJ_CONNECTING',
'PCJ_CONNECTED' => 'PCJ_CONNECTED',
'PCJ_CONNECTFAIL' => 'PCJ_CONNECTFAIL',
'PCJ_STREAMSTART' => 'PCJ_STEAMSTART',
'PCJ_STREAMEND' => 'PCJ_STREAMEND',
'PCJ_NODESENT' => 'PCJ_NODESENT',
'PCJ_NODERECEIVED' => 'PCJ_NODERECEIVED',
'PCJ_NODEQUEUED' => 'PCJ_NODEQUEUED',
'PCJ_SSLNEGOTIATE' => 'PCJ_SSLNEGOTIATE',
'PCJ_SSLSUCCESS' => 'PCJ_SSLSUCCESS',
'PCJ_SSLFAIL' => 'PCJ_SSLFAIL',
'PCJ_AUTHNEGOTIATE' => 'PCJ_AUTHNEGOTIATE',
'PCJ_AUTHSUCCESS' => 'PCJ_AUTHSUCCESS',
'PCJ_AUTHFAIL' => 'PCJ_AUTHFAIL',
'PCJ_BINDNEGOTIATE' => 'PCJ_BINDNEGOTIATE',
'PCJ_BINDSUCCESS' => 'PCJ_BINDSUCCESS',
'PCJ_BINDFAIL' => 'PCJ_BINDFAIL',
'PCJ_SESSIONNEGOTIATE' => 'PCJ_SESSIONNEGOTIATE',
'PCJ_SESSIONSUCCESS' => 'PCJ_SESSIONSUCCESS',
'PCJ_SESSIONFAIL' => 'PCJ_SESSIONFAIL',
'PCJ_RTS_START' => 'PCJ_RTS_START',
'PCJ_RTS_FINISH' => 'PCJ_RTS_FINISH',
'PCJ_READY' => 'PCJ_READY',
'PCJ_SHUTDOWN_START' => 'PCJ_SHUTDOWN_START',
'PCJ_SHUTDOWN_FINISH' => 'PCJ_SHUTDOWN_FINISH',
'PCJ_SOCKETFAIL' => 'PCJ_SOCKETFAIL',
'PCJ_SOCKETDISCONNECT' => 'PCJ_SOCKETDISCONNECT',
};
use base('Exporter');
our @EXPORT = qw/ PCJ_CONNECT PCJ_CONNECTING PCJ_CONNECTED PCJ_STREAMSTART
PCJ_SSLNEGOTIATE PCJ_SSLSUCCESS PCJ_AUTHNEGOTIATE PCJ_AUTHSUCCESS
PCJ_BINDNEGOTIATE PCJ_BINDSUCCESS PCJ_SESSIONNEGOTIATE PCJ_SESSIONSUCCESS
PCJ_NODESENT PCJ_NODERECEIVED PCJ_NODEQUEUED PCJ_RTS_START
PCJ_RTS_FINISH PCJ_READY PCJ_STREAMEND PCJ_SHUTDOWN_START
PCJ_SHUTDOWN_FINISH PCJ_SOCKETFAIL PCJ_SOCKETDISCONNECT PCJ_AUTHFAIL
PCJ_BINDFAIL PCJ_SESSIONFAIL PCJ_SSLFAIL PCJ_CONNECTFAIL /;
our $VERSION = '3.00';
1;
__END__
=pod
=head1 NAME
POE::Component::Jabber::Events
=head1 SYNOPSIS
PCJ_CONNECT
PCJ_CONNECTING
PCJ_CONNECTED
PCJ_CONNECTFAIL
PCJ_STREAMSTART
PCJ_STREAMEND
PCJ_NODESENT
PCJ_NODERECEIVED
PCJ_NODEQUEUED
PCJ_SSLNEGOTIATE
PCJ_SSLSUCCESS
PCJ_SSLFAIL
PCJ_AUTHNEGOTIATE
PCJ_AUTHSUCCESS
PCJ_AUTHFAIL
PCJ_BINDNEGOTIATE
PCJ_BINDSUCCESS
PCJ_BINDFAIL
PCJ_SESSIONNEGOTIATE
PCJ_SESSIONSUCCESS
PCJ_SESSIONFAIL
PCJ_RTS_START
PCJ_RTS_FINISH
PCJ_READY
PCJ_SHUTDOWN_START
PCJ_SHUTDOWN_FINISH
PCJ_SOCKETFAIL
PCJ_SOCKETDISCONNECT
=head1 DESCRIPTION
POE::Component::Jabber::Events exports many useful constants for tracking the
status of PCJ during its operation. Simply subscribe to these events in order
to receive notification.
=head1 EXPORTS
Below are the exported constants with a brief explanation of what it is
signalling to the end developer:
=over 4
=item PCJ_CONNECT
'connect' or 'reconnect' event has fired.
=item PCJ_CONNECTING
Connecting is now in process
=item PCJ_CONNECTED
Initial connection established
=item PCJ_STREAMSTART
A tag has been sent. The number of these events is variable
depending on which Protocol is currently active (ie. XMPP will send upto three,
while LEGACY will only send one).
=item PCJ_SSLNEGOTIATE
TLS/SSL negotiation has begun.
This event only is fired from XMPP and JABBERD20_COMPONENT connections.
=item PCJ_SSLSUCCESS
TLS/SSL negotiation has successfully complete. Socket layer is now encrypted.
This event only is fired from XMPP and JABBERD20_COMPONENT connections.
=item PCJ_SSLFAIL
TLS/SSL negotiation has failed.
This event only is fired from XMPP and JABBERD20_COMPONENT connections.
=item PCJ_AUTHNEGOTIATE
Whatever your authentication method (ie. iq:auth, SASL, , etc), it
is in process when this status is received.
=item PCJ_AUTHSUCCESS
Authentication was successful.
=item PCJ_AUTHFAIL
Authentication failed.
=item PCJ_BINDNEGOTIATE
For XMPP connections: this indicates resource binding negotiation has begun.
For JABBERD20_COMPONENT connections: domain binding negotiation has begun.
This event will not fire for any but the above two connection types.
=item PCJ_BINDSUCCESS
For XMPP connections: this indicates resource binding negotiation was
sucessful.
For JABBERD20_COMPONENT connections: domain binding negotiation was successful.
This event will not fire for any but the above two connection types.
=item PCJ_BINDFAIL
Binding for which ever context has failed.
=item PCJ_SESSIONNEGOTIATE
Only for XMPP: This indicates session binding (XMPP IM) negotiation has begun.
=item PCJ_SESSIONSUCCESS
Only for XMPP: This indicates session binding (XMPP IM) negotiation was
successful.
=item PCJ_SESSIONFAIL
Session negotiation has failed for which ever context.
=item PCJ_NODESENT
A Node has been placed, outbound, into the Wheel. ARG0 will be the node.
=item PCJ_NODERECEIVED
A Node has been received. ARG0 will be the node.
=item PCJ_NODEQUEUED
An attempt to send a Node while there is no valid, initialized connection was
caught. The Node has been queued. See POE::Component::Jabber event
'purge_queue' for details. ARG0 will be the node.
=item PCJ_RTS_START
A return_to_sender event has been fired for an outbound node. ARG0 will be the
node.
=item PCJ_RTS_FINISH
A return_to_sender event has been fired for a matching inbound node. ARG0 will
be the node.
=item PCJ_READY
This event indicates that the connection is fully initialized and ready for use.
Watch for this event and begin packet transactions AFTER it has been fired.
=item PCJ_STREAMEND
A Node has been sent. This indicates the end of the connection
and is called upon 'shutdown' of PCJ after the Node has been flushed.
=item PCJ_SHUTDOWN_START
This indicates that 'shutdown' has been fired and is currently in progress of
tearing down the connection.
=item PCJ_SHUTDOWN_FINISH
This indicates that 'shutdown' is complete.
=item PCJ_SOCKETFAIL
This indicates a socket level error. ARG0..ARG2 will be exactly what was passed
to us from POE::Wheel::ReadWrite.
=item PCJ_SOCKETDISCONNECT
This indicates the socket has disconnected and will occur in both normal, and
in error states.
=back
=head1 AUTHOR
(c) Copyright 2007-2009 Nicholas Perez. Released under the GPL.
=cut
POE-Component-Jabber-3.00/lib/POE/Component/Jabber/J2.pm 0000444 0001750 0001750 00000021746 11161375731 022532 0 ustar nicholas nicholas package POE::Component::Jabber::J2;
use warnings;
use strict;
use 5.010;
use POE qw/ Wheel::ReadWrite /;
use POE::Component::SSLify qw/ Client_SSLify /;
use POE::Component::Jabber::Events;
use POE::Filter::XML;
use POE::Filter::XML::Node;
use POE::Filter::XML::NS qw/ :JABBER :IQ /;
use Digest::MD5 qw/ md5_hex /;
use MIME::Base64;
use Authen::SASL;
use base('POE::Component::Jabber::Protocol');
our $VERSION = '3.00';
sub new()
{
my $class = shift;
my $self = {};
$self->{'SSLTRIES'} = 0;
return bless($self, $class);
}
sub get_version()
{
return '1.0';
}
sub get_xmlns()
{
return +NS_JABBER_COMPONENT;
}
sub get_states()
{
return [ 'set_auth', 'init_input_handler', 'challenge_response',
'binding', 'build_tls_wheel' ];
}
sub get_input_event()
{
return 'init_input_handler';
}
sub set_auth()
{
my ($kernel, $heap, $self, $mech) = @_[KERNEL, HEAP, OBJECT, ARG0];
my $config = $heap->config();
my $sasl = Authen::SASL->new
(
mechanism => 'DIGEST_MD5',
callback =>
{
user => $config->{'username'},
pass => $config->{'password'},
}
);
$self->{'challenge'} = $sasl;
my $node = POE::Filter::XML::Node->new('auth',
['xmlns', +NS_XMPP_SASL, 'mechanism', $mech]);
$kernel->yield('output_handler', $node, 1);
return;
}
sub challenge_response()
{
my ($kernel, $heap, $self, $node) = @_[KERNEL, HEAP, OBJECT, ARG0];
my $config = $heap->config();
if ($config->{'debug'}) {
$heap->debug_message(
"Server sent a challenge. Decoded Challenge:\n" .
decode_base64( $node->textContent() )
);
}
my $sasl = $self->{'challenge'};
my $conn = $sasl->client_new("xmpp", $config->{'hostname'});
$conn->client_start();
my $step = $conn->client_step(decode_base64($node->textContent()));
if ($config->{'debug'}) {
$heap->debug_message("Decoded Response:\n$step");
}
if(defined($step))
{
$step =~ s/\s+//go;
$step = encode_base64($step);
$step =~ s/\s+//go;
}
my $response = POE::Filter::XML::Node->new('response', ['xmlns', +NS_XMPP_SASL]);
$response->appendText($step) if defined($step);
$kernel->yield('output_handler', $response, 1);
}
sub init_input_handler()
{
my ($kernel, $heap, $self, $node) = @_[KERNEL, HEAP, OBJECT, ARG0];
my $attrs = $node->getAttributes();
my $config = $heap->config();
my $pending = $heap->pending();
if ($config->{'debug'})
{
$heap->debug_message("Recd: ".$node->toString());
}
if(exists($attrs->{'id'}))
{
if(defined($pending->{$attrs->{'id'}}))
{
my $array = delete $pending->{$attrs->{'id'}};
$kernel->post($array->[0], $array->[1], $node);
return;
}
}
given($node->nodeName())
{
when('stream:stream')
{
$self->{'sid'} = $node->getAttribute('id');
}
when('challenge')
{
$kernel->yield('challenge_response', $node);
}
when('failure')
{
if($node->getAttribute('xmlns') eq +NS_XMPP_SASL)
{
$heap->debug_message('SASL Negotiation Failed');
$kernel->yield('shutdown');
$kernel->post($heap->events(), +PCJ_AUTHFAIL);
}
else
{
$heap->debug_message('Unknown Failure: ' . $node->toString());
}
}
when('stream:features')
{
given($node->getChildrenHash())
{
when('starttls')
{
my $starttls = POE::Filter::XML::Node->new('starttls', ['xmlns', +NS_XMPP_TLS]);
$kernel->yield('output_handler', $starttls, 1);
$kernel->post($heap->events(), +PCJ_SSLNEGOTIATE);
$self->{'STARTTLS'} = 1;
}
when('mechanisms')
{
if(!defined($self->{'STARTTLS'}))
{
$kernel->post($heap->events(), +PCJ_SSLFAIL);
$kernel->yield('shutdown');
return;
}
foreach($_->{'mechanisms'}->[0]->getChildrenByTagName('*'))
{
when($_->textContent() eq 'DIGEST-MD5' or $_->textContent() eq 'PLAIN')
{
$kernel->yield('set_auth', $_->textContent());
$kernel->post($heap->events(), +PCJ_AUTHNEGOTIATE);
return;
}
}
$heap->debug_message('Unknown mechanism: '.$node->toString());
$kernel->yield('shutdown');
$kernel->post($heap->events(), +PCJ_AUTHFAIL);
}
when(sub() { !keys %$_; })
{
if(!defined($self->{'STARTTLS'}))
{
$kernel->post($heap->events(), +PCJ_SSLFAIL);
$kernel->yield('shutdown');
return;
}
my $bind = POE::Filter::XML::Node->new
(
'bind' ,
[
'xmlns', +NS_JABBER_COMPONENT,
'name', $config->{'binddomain'} || $config->{'username'} . '.' . $config->{'hostname'}
]
);
if(defined($config->{'bindoption'}))
{
$bind->appendChild($config->{'bindoption'});
}
$kernel->yield('return_to_sender', 'binding', $bind);
$kernel->post($heap->events(), +PCJ_BINDNEGOTIATE);
}
}
}
when('proceed')
{
$kernel->yield('build_tls_wheel');
$kernel->yield('initiate_stream');
}
when('success')
{
$kernel->yield('initiate_stream');
$kernel->post($heap->events(), +PCJ_AUTHSUCCESS);
}
}
return;
}
sub binding()
{
my ($kernel, $heap, $node) = @_[KERNEL, HEAP, ARG0];
my $attr = $node->getAttribute('error');
my $config = $heap->config();
if(!$attr)
{
$heap->relinquish_states();
$kernel->post($heap->events(), +PCJ_BINDSUCCESS);
$kernel->post($heap->events(), +PCJ_READY);
$heap->jid($config->{'binddomain'} ||
$config->{'username'} . '.' . $config->{'hostname'});
} else {
$heap->debug_message('Unable to BIND, yet binding required: '.
$node->toString());
$kernel->yield('shutdown');
$kernel->post($heap->events(), +PCJ_BINDFAIL);
}
}
sub build_tls_wheel()
{
my ($kernel, $heap, $self) = @_[KERNEL, HEAP, OBJECT];
$heap->wheel(undef);
eval { $heap->sock(Client_SSLify( $heap->sock() ))};
if($@)
{
if($self->{'SSLTRIES'} > 3)
{
$heap->debug_message('Unable to negotiate SSL: '. $@);
$self->{'SSLTRIES'} = 0;
$kernel->post($heap->events(), +PCJ_SSLFAIL, $@);
} else {
$self->{'SSLTRIES'}++;
$kernel->yield('build_tls_wheel');
}
return;
}
$heap->wheel(POE::Wheel::ReadWrite->new
(
'Handle' => $heap->sock(),
'Filter' => POE::Filter::XML->new(),
'InputEvent' => 'init_input_handler',
'ErrorEvent' => 'server_error',
'FlushedEvent' => 'flushed_event',
));
$kernel->post($heap->events(), +PCJ_SSLSUCCESS);
return;
}
1;
__END__
=pod
=head1 NAME
POE::Component::Jabber::J2
=head1 SYNOPSIS
PCJ::J2 is a Protocol implementation that is used to connect to the jabberd20
router as a service.
=head1 DESCRIPTION
PCJ::J2 implements the jabberd2 component spec located here:
(http://jabberd.jabberstudio.org/dev/docs/component.shtml)
Specifically, PCJ::J2 will negotiate TLS, SASL, and domain binding required
to establish a working connection with jabberd2 as a service.
=head1 METHODS
Please see PCJ::Protocol for what methods this class supports.
=head1 EVENTS
Listed are the exported events that make their way into the PCJ session:
=over 2
=item set_auth
This handles the initial SASL authentication portion of the connection.
=item init_input_handler
This is our entry point. This is what PCJ uses to deliver events to us.
It handles various responses until the connection is initialized fully.
=item build_tls_wheel
If TLS is required by the server, this is where that negotiation process
happens.
=item challenge_response
This handles the subsequent SASL authentication steps.
=item binding
This handles the domain binding
=back
=head1 NOTES AND BUGS
This Protocol may implement the spec, but this spec hasn't been touched in
quite some time. If for some reason my implementation fails against a
particular jabberd2 version, please let me know.
The underlying backend has changed this release to now use a new Node
implementation based on XML::LibXML::Element. Please see POE::Filter::XML::Node
documentation for the relevant API changes.
=head1 AUTHOR
Copyright (c) 2003-2009 Nicholas Perez. Distributed under the GPL.
=cut
POE-Component-Jabber-3.00/lib/POE/Component/Jabber/Protocol.pm 0000444 0001750 0001750 00000011240 11161375731 024044 0 ustar nicholas nicholas package POE::Component::Jabber::Protocol;
use warnings;
use strict;
our $VERSION = '3.00';
sub new()
{
my $class = shift(@_);
return bless({}, $class);
}
sub get_version()
{
return undef;
}
sub get_xmlns()
{
return undef;
}
sub get_states()
{
return undef;
}
sub get_input_event()
{
return undef;
}
sub get_error_event()
{
return undef;
}
sub get_flushed_event()
{
return undef;
}
1;
__END__
=pod
=head1 NAME
POE::Component::Jabber::Protocol - A base class for implementing protocol
differences
=head1 SYNOPSIS
Inherit from this base class when implementing specifc protocol extentions that
may exist when writing to support various other jabber server implementations.
=head1 DESCRIPTION
PCJ::Protocol is the base class used when differences between authentication
or other connection initialization methods require special processing.
A prime example is JABBER(tm) vs. XMPP. The Jabber protocol uses a much
different method to authenticate (ie. using the iq:auth namespace) than XMPP
which uses SASL. While the rest of the protocol is substantially unchanged,
these differences mean they must be accounted. In the 1.x versions of PCJ,
this was solved by having different duplicate classes in the same domain with
these differences manifest. It led to lots of headaches if there was a problem
because it then needed to be fixed in four places.
The solution is to keep the core aspect of PCJ immutable, while loading
separate individual Protocol classes that then implement the details for each
specific dialect.
As an end developer, if you wish to add support for another dialect (ie.
support another jabber server implementation that does service management
differently), subclass from this module and then add your entry into the
ProtocolFactory.
Also be aware that PCJ uses object_states to construct its own session.
Protocol subclassees are expected to fit smoothly into that. See the METHOD
get_states() for more information.
And remember when you are finished handling the protocol specifics and the
connection is finished, fire off the PCJ_INIT_FINISHED status, and call
relinquish_states() from the $_[HEAP] object to return control back to the PCJ
Core. (Yes, you read that correctly, $_[HEAP] is actually the PCJ object).
If in doubt, please see the source code for the other Protocol subclasses (ie.
XMPP.pm, J14.pm, etc).
=head1 METHODS
At a bare minimum, some methods must be implemented by the end developer. These
will be indicated with a MANDATORY flag.
=over 4
=item new() [OPTIONAL]
new() provides a default constructor. It returns a hash reference blessed into
the provided class
=item get_version() [MANDATORY]
get_version() is used by PCJ to populate the 'version' attribute in the opening
. For XMPP enabled clients, this must return '1.0'. For legacy
Jabber connections, it should return '0.9' but it isn't required. For all other
applications, see the appropriate RFC for details on what version it expects.
=item get_xmlns() [MANDATORY]
get_xmlns() is used by PCJ to populate the default XML namespace attribute in
the opening . Please feel free to use the constants in
POE::Filter::XML::NS to provide this.
=item get_states() [MANDATORY]
get_states is used by PCJ to fill its object_states with the Protocol states.
An array reference containing event names should be returned that corespond
one-to-one with the methods you implement in your subclass. Or if a mapping is
required, a hash reference should be returned that includes the mapping. See
POE::Session for more detail on object_states.
=item get_input_event() [MANDATORY]
get_input_event() returns the main entry point event into the Protocol
subclass. This is then used by PCJ to assign the event to the Wheel, so that
the Protocol's events get fired from Wheel events.
=item get_error_event() [OPTIONAL]
get_error_event() returns the event to be called when an error occurs in the
Wheel. Typically, this isn't required for Protocol subclasses, but is available
if needed.
=item get_flushed_event() [OPTIONAL]
get_flushed_event() returns the event to be called when the flushed event
occurs in the Wheel. Typically, this isn't required for Protocol subclasses,
but is available if needed.
=back
=head1 NOTES
Here are some quick tips to keep in mind when subclassing:
Protocol subclassees execute within the same Session space as PCJ
$_[HEAP] contains the PCJ object.
If you need storage space, use $_[OBJECT] (ie. yourself).
Send status events. See PCJ::Status
Don't forget to send PCJ_READY.
And don't forget to call $_[HEAP]->relinquish_states() when finished.
When in doubt, use the source!
=head1 AUTHOR
Copyright (c) 2007-2009 Nicholas Perez. Distributed under the GPL.
=cut
POE-Component-Jabber-3.00/lib/POE/Component/Jabber/ProtocolFactory.pm 0000444 0001750 0001750 00000004343 11161375731 025402 0 ustar nicholas nicholas package POE::Component::Jabber::ProtocolFactory;
use warnings;
use strict;
use Carp;
use POE::Component::Jabber::XMPP;
use POE::Component::Jabber::Legacy;
use POE::Component::Jabber::J14;
use POE::Component::Jabber::J2;
use constant
{
'JABBERD14_COMPONENT' => 0,
'LEGACY' => 1,
'JABBERD20_COMPONENT' => 2,
'XMPP' => 4,
};
use base('Exporter');
our @EXPORT = qw/ JABBERD14_COMPONENT JABBERD20_COMPONENT LEGACY XMPP /;
our $VERSION = '3.00';
sub get_guts($)
{
my $type = shift(@_);
Carp::confess('No argument provided') if not defined($type);
Carp::confess('Invalid Helper type: ' . $type) if $type =~ /\D+/;
if($type == +XMPP)
{
return POE::Component::Jabber::XMPP->new();
} elsif ($type == +LEGACY) {
return POE::Component::Jabber::Legacy->new();
} elsif ($type == +JABBERD14_COMPONENT) {
return POE::Component::Jabber::J14->new();
} elsif ($type == +JABBERD20_COMPONENT) {
return POE::Component::Jabber::J2->new();
} else {
Carp::confess('Unknown Helper type: ' . $type);
}
}
1;
__END__
=pod
=head1 NAME
POE::Component::Jabber::ProtocolFactory
=head1 SYNOPSIS
PCJ::ProtocolFactory is a protected helper class used to instantiate specific
Protocols based on exported constants
=head1 DESCRIPTION
PCJ internally uses PCJ::ProtocolFactory to turn the ConnectionType argument
into a Protocol object used to implement the various supported dialects. This
is why the accepted arguments are exported as constants upon use.
=head1 FUNCTIONS
By default no functions are exported beyond the accepted arguments. Only a
package function is available:
=over 4
=item get_guts [Protected]
get_guts takes a single argument and that is a defined constant exported by
this module. It returns a PCJ::Protocol object.
See PCJ::Protocol for details on its methods and implementing different
Protocols.
=back
=head1 CONSTANTS
Below are the constants that are exported. Their names are rather
self-explanatory:
=over 4
=item XMPP
=item LEGACY
=item JABBERD14_COMPONENT
=item JABBERD20_COMPONENT
=back
=head1 NOTES
All supported Protocol types are implemented herein. get_guts will confess if it
receives an invalid argument.
=head1 AUTHOR
(c) Copyright 2007-2009 Nicholas Perez. Released under the GPL.
=cut
POE-Component-Jabber-3.00/lib/POE/Component/Jabber/Legacy.pm 0000444 0001750 0001750 00000007453 11161375731 023462 0 ustar nicholas nicholas package POE::Component::Jabber::Legacy;
use warnings;
use strict;
use 5.010;
use POE;
use POE::Component::Jabber::Events;
use POE::Filter::XML;
use POE::Filter::XML::Node;
use POE::Filter::XML::NS qw/ :JABBER :IQ /;
use Digest::SHA1 qw/ sha1_hex /;
use base('POE::Component::Jabber::Protocol');
our $VERSION = '3.00';
sub get_version()
{
return '0.9';
}
sub get_xmlns()
{
return +NS_JABBER_CLIENT;
}
sub get_states()
{
return [ 'set_auth', 'init_input_handler' ];
}
sub get_input_event()
{
return 'init_input_handler';
}
sub set_auth()
{
my ($kernel, $heap) = @_[KERNEL, HEAP];
my $config = $heap->config();
my $node = POE::Filter::XML::Node->new('iq', ['type', +IQ_SET, 'id', 'AUTH']);
my $query = $node->appendChild('query', ['xmlns', +NS_JABBER_AUTH]);
$query->appendChild('username')->appendText($config->{'username'});
if($config->{'plaintext'})
{
$query->appendChild('password')->appendText($config->{'password'});
} else {
my $hashed = sha1_hex($heap->sid().$config->{'password'});
$query->appendChild('digest')->appendText($hashed);
}
$query->appendChild('resource')->appendText($config->{'resource'});
$kernel->yield('output_handler', $node, 1);
$heap->jid($config->{'username'} . '@' . $config->{'hostname'} . '/' .
$config->{'resource'});
return;
}
sub init_input_handler()
{
my ($kernel, $heap, $node) = @_[KERNEL, HEAP, ARG0];
my $config = $heap->config();
if ($config->{'debug'})
{
$heap->debug_message( "Recd: ".$node->toString() );
}
given($node->nodeName())
{
when('stream:stream')
{
$heap->sid($node->getAttribute('id'));
$kernel->yield('set_auth');
$kernel->post($heap->events(), +PCJ_AUTHNEGOTIATE);
}
when('iq')
{
given([$node->getAttribute('type'), $node->getAttribute('id')])
{
when([+IQ_RESULT, 'AUTH'])
{
$heap->relinquish_states();
$kernel->post($heap->events(), +PCJ_AUTHSUCCESS);
$kernel->post($heap->events(), +PCJ_READY);
}
when([+IQ_ERROR, 'AUTH']) {
$heap->debug_message('Authentication Failed');
$kernel->yield('shutdown');
$kernel->post($heap->events(), +PCJ_AUTHFAIL);
}
}
}
}
return;
}
1;
__END__
=pod
=head1 NAME
POE::Component::Jabber::Legacy
=head1 SYNOPSIS
PCJ::Legacy is a Protocol implementation for the legacy (ie. Pre-XMPP) Jabber
protocol.
=head1 DESCRIPTION
PCJ::Legacy implements the simple iq:auth authentication mechanism defined in
the deprecated XEP at http://www.xmpp.org/extensions/xep-0078.html. This
Protocol class is mainly used for connecting to legacy jabber servers that do
not conform the to XMPP1.0 RFC.
=head1 METHODS
Please see PCJ::Protocol for what methods this class supports.
=head1 EVENTS
Listed below are the exported events that end up in PCJ's main session:
=over 2
=item set_auth
This handles construction and sending of the iq:auth query.
=item init_input_handler
This is our main entry point. This is used by PCJ to deliver all input events
until we are finished. Also handles responses to authentication.
=back
=head1 NOTES AND BUGS
Ideally, this class wouldn't be necessary, but there is a large unmoving mass
of entrenched users and administrators that refuse to migrate to XMPP. It
largely doesn't help that debian still ships jabberd 1.4.3 which does NOT
support XMPP.
The underlying backend has changed this release to now use a new Node
implementation based on XML::LibXML::Element. Please see POE::Filter::XML::Node
documentation for the relevant API changes.
=head1 AUTHOR
Copyright (c) 2003-2009 Nicholas Perez. Distributed under the GPL.
=cut
POE-Component-Jabber-3.00/lib/POE/Component/Jabber/XMPP.pm 0000444 0001750 0001750 00000030173 11161375731 023035 0 ustar nicholas nicholas package POE::Component::Jabber::XMPP;
use warnings;
use strict;
use 5.010;
use POE qw/ Wheel::ReadWrite /;
use POE::Component::SSLify qw/ Client_SSLify /;
use POE::Component::Jabber::Events;
use POE::Filter::XML;
use POE::Filter::XML::Node;
use POE::Filter::XML::NS qw/ :JABBER :IQ /;
use Digest::MD5 qw/ md5_hex /;
use MIME::Base64;
use Authen::SASL;
use base('POE::Component::Jabber::Protocol');
our $VERSION = '3.00';
sub get_version()
{
return '1.0';
}
sub get_xmlns()
{
return +NS_JABBER_CLIENT;
}
sub get_states()
{
return
[
'set_auth',
'init_input_handler',
'build_tls_wheel',
'challenge_response',
'binding',
'session_establish',
];
}
sub get_input_event()
{
return 'init_input_handler';
}
sub set_auth()
{
my ($kernel, $heap, $self, $mech) = @_[KERNEL, HEAP, OBJECT, ARG0];
my $config = $heap->config();
$self->{'challenge'} = Authen::SASL->new
(
mechanism => $mech,
callback =>
{
user => $config->{'username'},
pass => $config->{'password'},
}
);
my $node = POE::Filter::XML::Node->new('auth', ['xmlns', +NS_XMPP_SASL, 'mechanism', $mech]);
if ($mech eq 'PLAIN')
{
my $auth_str = '';
$auth_str .= "\0";
$auth_str .= $config->{'username'};
$auth_str .= "\0";
$auth_str .= $config->{'password'};
$node->appendText(encode_base64($auth_str));
}
$kernel->yield('output_handler', $node, 1);
return;
}
sub challenge_response()
{
my ($kernel, $heap, $self, $node) = @_[KERNEL, HEAP, OBJECT, ARG0];
my $config = $heap->config();
if ($config->{'debug'}) {
$heap->debug_message("Server sent a challenge. Decoded Challenge:\n".
decode_base64($node->textContent()));
}
my $sasl = $self->{'challenge'};
my $conn = $sasl->client_new('xmpp', $config->{'hostname'});
$conn->client_start();
my $step = $conn->client_step(decode_base64($node->textContent()));
$step ||= '';
if ($config->{'debug'}) {
$heap->debug_message("Decoded Response:\n$step");
}
$step =~ s/\s+//go;
$step = encode_base64($step);
$step =~ s/\s+//go;
my $response = POE::Filter::XML::Node->new('response', ['xmlns', +NS_XMPP_SASL]);
$response->appendText($step);
$kernel->yield('output_handler', $response, 1);
return;
}
sub init_input_handler()
{
my ($kernel, $heap, $self, $node) = @_[KERNEL, HEAP, OBJECT, ARG0];
my $attrs = $node->getAttributes();
my $config = $heap->config();
my $name = $node->nodeName();
if ($config->{'debug'})
{
$heap->debug_message("Recd: ".$node->toString());
}
if(exists($attrs->{'id'}))
{
my $pending = $heap->pending();
if(defined($pending->{$attrs->{'id'}}))
{
my $array = delete $pending->{$attrs->{'id'}};
$kernel->post($array->[0], $array->[1], $node);
return;
}
}
given($name)
{
when ('stream:stream')
{
$self->{'sid'} = $attrs->{'id'};
}
when ('challenge')
{
$kernel->yield('challenge_response', $node);
}
when ('failure')
{
$heap->debug_message('SASL Negotiation Failed');
$kernel->yield('shutdown');
$kernel->post($heap->events(), +PCJ_AUTHFAIL);
}
when ('stream:features')
{
given(my $clist = $node->getChildrenHash())
{
when ('starttls')
{
my $starttls = POE::Filter::XML::Node->new('starttls', ['xmlns', +NS_XMPP_TLS]);
$kernel->yield('output_handler', $starttls, 1);
$kernel->post($heap->events(), +PCJ_SSLNEGOTIATE);
}
when('mechanisms')
{
$self->{'MECHANISMS'} = 1;
foreach($clist->{'mechanisms'}->[0]->getChildrenByTagName('*'))
{
when($_->textContent() eq 'DIGEST-MD5' or $_->textContent() eq 'PLAIN')
{
$kernel->yield('set_auth', $_->textContent());
$kernel->post($heap->events(), +PCJ_AUTHNEGOTIATE);
return;
}
}
$heap->debug_message('Unknown mechanism: '.$node->toString());
$kernel->yield('shutdown');
$kernel->post($heap->events(), +PCJ_AUTHFAIL);
}
when('bind')
{
my $iq = POE::Filter::XML::Node->new('iq', ['type', +IQ_SET]);
$iq->appendChild('bind', ['xmlns', +NS_XMPP_BIND])
->appendChild('resource')
->appendText($config->{'resource'});
$self->{'STARTSESSION'} = 1 if exists($clist->{'session'});
$kernel->yield('return_to_sender', 'binding', $iq);
$kernel->post($heap->events(), +PCJ_BINDNEGOTIATE);
}
default
{
# If we get here, it means the server has decided TLS isn't
# necessary, or that it is a non-compliant server and has skipped
# SASL negotition. Check for MECHANISMS flag. If it is present then
# we are finished with connection initialization.
#
# See http://www.xmpp.org/rfcs/rfc3920.html for more info
if($self->{'MECHANISMS'})
{
$heap->relinquish_states();
$kernel->post(
$heap->events(),
+PCJ_READY);
} else {
$heap->debug_message('Non-compliant server implementation! '.
'SASL negotiation not initiated.');
$kernel->yield('shutdown');
$kernel->post($heap->events(), +PCJ_AUTHFAIL);
}
}
}
}
when ('proceed')
{
$kernel->yield('build_tls_wheel');
}
when('success')
{
$kernel->yield('initiate_stream');
$kernel->post($heap->events(), +PCJ_AUTHSUCCESS);
}
}
return;
}
sub binding()
{
my ($kernel, $heap, $self, $node) = @_[KERNEL, HEAP, OBJECT, ARG0];
my $attr = $node->getAttribute('type');
my $config = $heap->config();
given($attr)
{
when(+IQ_RESULT)
{
if($self->{'STARTSESSION'})
{
my $iq = POE::Filter::XML::Node->new('iq', ['type', +IQ_SET]);
$iq->appendChild('session', ['xmlns', +NS_XMPP_SESSION]);
$kernel->yield('return_to_sender', 'session_establish', $iq);
$kernel->post($heap->events(), +PCJ_BINDSUCCESS);
$kernel->post(
$heap->events(),
+PCJ_SESSIONNEGOTIATE);
} else {
$heap->relinquish_states();
$kernel->post($heap->events(), +PCJ_BINDSUCCESS);
$kernel->post($heap->events(), +PCJ_READY);
}
$heap->jid($node->getSingleChildByTagName('bind')->getSingleChildByTagName('jid')->textContent());
}
when(+IQ_ERROR)
{
my $error = $node->getSingleChildByTagName('error');
my $type = $error->getAttribute('type');
given($type)
{
when('modify')
{
my $iq = POE::Filter::XML::Node->new('iq', ['type', +IQ_SET]);
$iq->appendChild('bind', ['xmlns', +NS_XMPP_BIND])
->appendChild('resource')
->appendText(md5_hex(time().rand().$$.rand().$^T.rand()));
$kernel->yield('return_to_sender', 'binding', $iq);
}
when('cancel')
{
my $clist = $error->getChildrenHash();
if(exists($clist->{'conflict'}))
{
my $iq = POE::Filter::XML::Node->new('iq', ['type', +IQ_SET]);
$iq->appendChild('bind', ['xmlns', +NS_XMPP_BIND])
->appendChild('resource')
->appendText(md5_hex(time().rand().$$.rand().$^T.rand()));
$kernel->yield('return_to_sender', 'binding', $iq);
} else {
$heap->debug_message('Unable to BIND, yet binding required: '.
$node->toString());
$kernel->yield('shutdown');
$kernel->post($heap->events(), +PCJ_BINDFAIL);
}
}
}
}
}
return;
}
sub session_establish()
{
my ($kernel, $heap, $node) = @_[KERNEL, HEAP, ARG0];
my $attr = $node->getAttribute('type');
my $config = $heap->config();
given($attr)
{
when(+IQ_RESULT)
{
$heap->relinquish_states();
$kernel->post($heap->events(), +PCJ_SESSIONSUCCESS);
$kernel->post($heap->events(), +PCJ_READY);
}
when(+IQ_ERROR)
{
$heap->debug_message('Unable to intiate SESSION, yet session required');
$heap->debug_message($node->toString());
$kernel->yield('shutdown');
$kernel->post($heap->events(), +PCJ_SESSIONFAIL);
}
}
return;
}
sub build_tls_wheel()
{
my ($self, $kernel, $heap) = @_[OBJECT, KERNEL, HEAP];
$heap->wheel(undef);
eval
{
$heap->sock(Client_SSLify($heap->sock()));
};
if($@)
{
if($self->{'SSLTRIES'} > 3)
{
$heap->debug_message('Unable to negotiate SSL: '. $@);
$self->{'SSLTRIES'} = 0;
$kernel->post($heap->events(), +PCJ_SSLFAIL, $@);
} else {
$self->{'SSLTRIES'}++;
$kernel->yield('build_tls_wheel');
}
} else {
$heap->wheel(POE::Wheel::ReadWrite->new
(
'Handle' => $heap->sock(),
'Filter' => POE::Filter::XML->new(),
'InputEvent' => 'input_handler',
'ErrorEvent' => 'server_error',
'FlushedEvent' => 'flushed',
));
$kernel->yield('initiate_stream');
$kernel->post($heap->events(), +PCJ_SSLSUCCESS);
}
return;
}
1;
__END__
=pod
=head1 NAME
POE::Component::Jabber::XMPP
=head1 SYNOPSIS
This is a Protocol implementation for the specifics in the XMPP protocol during
connection initialization.
=head1 DESCRIPTION
PCJ::XMPP provides all the mechanisms to negotiate TLS, SASL, resource binding,
and session negotiation that PCJ needs to successfully establish an XMPP
connection. In essence, it implements XMPP Core and a smidgeon of XMPP IM.
=head1 METHODS
Please see PCJ::Protocol for what methods this class supports.
=head1 EVENTS
Listed are the exported events that make their way into the PCJ session:
=over 2
=item set_auth
This handles the initial SASL authentication portion of the XMPP connection.
=item init_input_handler
This is our entry point. This is what PCJ uses to deliver events to us.
=item build_tls_wheel
If TLS is required by the server, this is where that negotiation process
happens.
=item challenge_response
This handles the subsequent SASL authentication steps.
=item binding
This handles the resource binding
=item session_establish
This handles session binding.
=back
=head1 NOTES AND BUGS
Currently, only DIGEST-MD5 and PLAIN SASL mechanisms are supported. Server
implementations are free to include more strigent mechanisms, but these are the
bare minimum required. (And PLAIN isn't /really/ allowed by the spec, but it is
included because it was a requested feature)
The underlying backend has changed this release to now use a new Node
implementation based on XML::LibXML::Element. Please see POE::Filter::XML::Node
documentation for the relevant API changes.
=head1 AUTHOR
Copyright (c) 2003-2009 Nicholas Perez. Distributed under the GPL.
=cut
POE-Component-Jabber-3.00/lib/POE/Component/Jabber.pm 0000444 0001750 0001750 00000075125 11161375731 022257 0 ustar nicholas nicholas package POE::Component::Jabber;
use warnings;
use strict;
use 5.010;
use POE;
use POE::Wheel::ReadWrite;
use POE::Wheel::SocketFactory;
use POE::Component::PubSub;
use POE::Component::Jabber::Events;
use POE::Component::Jabber::ProtocolFactory;
use POE::Filter::XML;
use POE::Filter::XML::Node;
use POE::Filter::XML::NS(':JABBER');
use Digest::MD5('md5_hex');
use Carp;
use constant
{
'_pcj_config' => 0,
'_pcj_sock' => 1,
'_pcj_sfwheel' => 2,
'_pcj_wheel' => 3,
'_pcj_id' => 4,
'_pcj_sid' => 5,
'_pcj_jid' => 6,
'_pcj_helper' => 7,
'_pcj_shutdown' => 8,
'_pcj_parent' => 9,
'_pcj_input' => 10,
'_pcj_events' => 11,
'_pcj_pending' => 12,
'_pcj_queue' => 13,
'_pcj_init_finished' => 14,
'_pcj_xpathfilters' => 15,
'EVENT' => 0,
'EXPRESSION' => 1,
};
use base('Exporter');
our @EXPORT = qw/ JABBERD14_COMPONENT JABBERD20_COMPONENT LEGACY XMPP
PCJ_CONNECT PCJ_CONNECTING PCJ_CONNECTED PCJ_STREAMSTART
PCJ_SSLNEGOTIATE PCJ_SSLSUCCESS PCJ_AUTHNEGOTIATE PCJ_AUTHSUCCESS
PCJ_BINDNEGOTIATE PCJ_BINDSUCCESS PCJ_SESSIONNEGOTIATE PCJ_SESSIONSUCCESS
PCJ_RECONNECT PCJ_NODESENT PCJ_NODERECEIVED PCJ_NODEQUEUED PCJ_RTS_START
PCJ_RTS_FINISH PCJ_READY PCJ_STREAMEND PCJ_SHUTDOWN_START
PCJ_SHUTDOWN_FINISH PCJ_SOCKETFAIL PCJ_SOCKETDISCONNECT PCJ_AUTHFAIL
PCJ_BINDFAIL PCJ_SESSIONFAIL PCJ_SSLFAIL PCJ_CONNECTFAIL PCJ_XPATHFILTER /;
our $VERSION = '3.00';
sub new()
{
my $class = shift;
my $self = [];
$self->[+_pcj_pending] = {};
bless($self, $class);
my $me = $class . '->new()';
Carp::confess "$me requires an even number of arguments" if(@_ & 1);
$self->_gather_options(\@_);
my $args = $self->[+_pcj_config];
$self->[+_pcj_helper] =
POE::Component::Jabber::ProtocolFactory::get_guts
(
$args->{'connectiontype'}
);
$args->{'version'} ||= $self->[+_pcj_helper]->get_version();
$args->{'xmlns'} ||= $self->[+_pcj_helper]->get_xmlns();
$args->{'alias'} ||= 'POE_COMPONENT_JABBER';
$args->{'stream'} ||= +XMLNS_STREAM;
$args->{'debug'} ||= 0 ;
$args->{'resource'} ||= md5_hex(time().rand().$$.rand().$^T.rand());
$self->[+_pcj_events] = $args->{'alias'};
Carp::confess "$me requires ConnectionType to be defined" if not defined
$args->{'connectiontype'};
Carp::confess "$me requires Username to be defined" if not defined
$args->{'username'};
Carp::confess "$me requires Password to be defined" if not defined
$args->{'password'};
Carp::confess "$me requires Hostname to be defined" if not defined
$args->{'hostname'};
Carp::confess "$me requires IP to be defined" if not defined
$args->{'ip'};
Carp::confess "$me requires Port to be defined" if not defined
$args->{'port'};
$POE::Component::PubSub::TRACE_AND_DEBUG = $args->{'debug'};
POE::Component::PubSub->new($args->{'alias'});
POE::Session->create
(
'object_states' =>
[
$self =>
[
'_start',
'initiate_stream',
'connect',
'_connect',
'connected',
'disconnected',
'shutdown',
'output_handler',
'debug_output_handler',
'input_handler',
'debug_input_handler',
'return_to_sender',
'connect_error',
'server_error',
'flushed',
'_stop',
'purge_queue',
'debug_purge_queue',
'xpath_filter',
'halt',
],
$self =>
{
'reconnect' => 'connect'
},
$self->[+_pcj_helper] => $self->[+_pcj_helper]->get_states(),
],
'options' =>
{
'trace' => $args->{'debug'},
'debug' => $args->{'debug'},
},
'heap' => $self,
);
return $self;
}
sub wheel()
{
if(@_ > 1)
{
my ($self, $arg) = @_;
$self->[+_pcj_wheel] = $arg;
} else {
return shift(@_)->[+_pcj_wheel];
}
}
sub sock()
{
if(@_ > 1)
{
my ($self, $arg) = @_;
$self->[+_pcj_sock] = $arg;
} else {
return shift(@_)->[+_pcj_sock];
}
}
sub config()
{
if(@_ > 1)
{
my ($self, $arg) = @_;
$self->[+_pcj_config] = $arg;
} else {
return shift(@_)->[+_pcj_config];
}
}
sub sid()
{
if(@_ > 1)
{
my ($self, $arg) = @_;
$self->[+_pcj_sid] = $arg;
} else {
return shift(@_)->[+_pcj_sid];
}
}
sub jid()
{
if(@_ > 1)
{
my ($self, $arg) = @_;
$self->[+_pcj_jid] = $arg;
} else {
return shift(@_)->[+_pcj_jid];
}
}
sub input()
{
if(@_ > 1)
{
my ($self, $arg) = @_;
$self->[+_pcj_input] = $arg;
} else {
return shift(@_)->[+_pcj_input];
}
}
sub events()
{
if(@_ > 1)
{
my ($self, $arg) = @_;
$self->[+_pcj_events] = $arg;
} else {
return shift(@_)->[+_pcj_events];
}
}
sub pending()
{
if(@_ > 1)
{
my ($self, $arg) = @_;
$self->[+_pcj_pending] = $arg;
} else {
return shift(@_)->[+_pcj_pending];
}
}
sub queue()
{
if(@_ > 1)
{
my ($self, $arg) = @_;
$self->[+_pcj_queue] = $arg;
} else {
return shift(@_)->[+_pcj_queue];
}
}
sub _gather_options()
{
my ($self, $args) = @_;
my $opts = {};
while(@$args != 0)
{
my $key = lc(shift(@{$args}));
my $value = shift(@{$args});
if(ref($value) eq 'HASH')
{
my $hash = {};
foreach my $sub_key (keys %$value)
{
$hash->{lc($sub_key)} = $value->{$sub_key};
}
$opts->{$key} = $hash;
next;
}
$opts->{$key} = $value;
}
$self->[+_pcj_config] = $opts;
return $self;
}
sub connect_error()
{
my ($kernel, $self, $call, $code, $err) = @_[KERNEL, OBJECT, ARG0..ARG2];
$self->debug_message("Connect Error: $call: $code -> $err\n");
$kernel->post($self->[+_pcj_events], +PCJ_CONNECTFAIL, $call, $code, $err);
return;
}
sub _start()
{
my ($kernel, $self) = @_[KERNEL, OBJECT];
$kernel->alias_set($self->[+_pcj_config]->{'alias'} . 'CORE');
$self->_reset();
if($self->[+_pcj_config]->{'debug'})
{
$kernel->state('output_handler', $self, 'debug_output_handler');
$kernel->state('purge_queue', $self, 'debug_purge_queue');
}
$self->[+_pcj_queue] = [];
$self->[+_pcj_xpathfilters] = [];
my $pubsub = $self->[+_pcj_events];
$kernel->call($pubsub, 'publish', +PCJ_SOCKETFAIL);
$kernel->call($pubsub, 'publish', +PCJ_SOCKETDISCONNECT);
$kernel->call($pubsub, 'publish', +PCJ_AUTHFAIL);
$kernel->call($pubsub, 'publish', +PCJ_BINDFAIL);
$kernel->call($pubsub, 'publish', +PCJ_SESSIONFAIL);
$kernel->call($pubsub, 'publish', +PCJ_SSLFAIL);
$kernel->call($pubsub, 'publish', +PCJ_CONNECTFAIL);
$kernel->call($pubsub, 'publish', +PCJ_CONNECT);
$kernel->call($pubsub, 'publish', +PCJ_CONNECTING);
$kernel->call($pubsub, 'publish', +PCJ_CONNECTED);
$kernel->call($pubsub, 'publish', +PCJ_SSLNEGOTIATE);
$kernel->call($pubsub, 'publish', +PCJ_SSLSUCCESS);
$kernel->call($pubsub, 'publish', +PCJ_AUTHNEGOTIATE);
$kernel->call($pubsub, 'publish', +PCJ_AUTHSUCCESS);
$kernel->call($pubsub, 'publish', +PCJ_BINDNEGOTIATE);
$kernel->call($pubsub, 'publish', +PCJ_BINDSUCCESS);
$kernel->call($pubsub, 'publish', +PCJ_SESSIONNEGOTIATE);
$kernel->call($pubsub, 'publish', +PCJ_SESSIONSUCCESS);
$kernel->call($pubsub, 'publish', +PCJ_NODESENT);
$kernel->call($pubsub, 'publish', +PCJ_NODERECEIVED);
$kernel->call($pubsub, 'publish', +PCJ_NODEQUEUED);
$kernel->call($pubsub, 'publish', +PCJ_RTS_START);
$kernel->call($pubsub, 'publish', +PCJ_RTS_FINISH);
$kernel->call($pubsub, 'publish', +PCJ_READY);
$kernel->call($pubsub, 'publish', +PCJ_STREAMEND);
$kernel->call($pubsub, 'publish', +PCJ_STREAMSTART);
$kernel->call($pubsub, 'publish', +PCJ_SHUTDOWN_START);
$kernel->call($pubsub, 'publish', +PCJ_SHUTDOWN_FINISH);
$kernel->call($pubsub, 'publish', 'output',
+PUBLISH_INPUT, 'output_handler');
$kernel->call($pubsub, 'publish', 'return_to_sender',
+PUBLISH_INPUT, 'return_to_sender');
$kernel->call($pubsub, 'publish', 'xpath_filter',
+PUBLISH_INPUT, 'xpath_filter');
$kernel->call($pubsub, 'publish', 'shutdown',
+PUBLISH_INPUT, 'shutdown');
$kernel->call($pubsub, 'publish', 'connect',
+PUBLISH_INPUT, 'connect');
$kernel->call($pubsub, 'publish', 'reconnect',
+PUBLISH_INPUT, 'reconnect');
$kernel->call($pubsub, 'publish', 'purge_queue',
+PUBLISH_INPUT, 'purge_queue');
$kernel->call($pubsub, 'publish', 'halt',
+PUBLISH_INPUT, 'halt');
return;
}
sub _stop()
{
my ($kernel, $self) = @_[KERNEL, OBJECT];
$kernel->alias_remove($_) for $kernel->alias_list();
return;
}
sub halt()
{
my ($kernel, $self) = @_[KERNEL, OBJECT];
$self->[+_pcj_wheel] = undef;
$self->[+_pcj_sfwheel] = undef;
$self->[+_pcj_sock]->close() if defined($self->[+_pcj_sock]);
$self->[+_pcj_sock] = undef;
$kernel->call($self->[+_pcj_events], 'destroy');
$kernel->alias_remove($_) for $kernel->alias_list();
return;
}
sub _reset()
{
my $self = shift;
$self->[+_pcj_sid] = 0;
$self->[+_pcj_pending] = {};
$self->[+_pcj_init_finished] = 0;
$self->[+_pcj_id] ||= Digest::SHA1->new();
$self->[+_pcj_id]->add(time().rand().$$.rand().$^T.rand());
$self->[+_pcj_wheel] = undef;
$self->[+_pcj_sfwheel] = undef;
$self->[+_pcj_sock]->close() if defined($self->[+_pcj_sock]);
$self->[+_pcj_sock] = undef;
return;
}
sub connect()
{
my ($kernel, $self, $ip, $port) = @_[KERNEL, OBJECT, ARG0, ARG1];
$self->[+_pcj_config]->{'ip'} = $ip if defined $ip;
$self->[+_pcj_config]->{'port'} = $port if defined $port;
$self->_reset();
$kernel->yield('_connect');
$kernel->post($self->[+_pcj_events], +PCJ_CONNECT);
return;
}
sub _connect()
{
my ($kernel, $self) = @_[KERNEL, OBJECT];
$self->[+_pcj_sfwheel] = POE::Wheel::SocketFactory->new
(
'RemoteAddress' => $self->[+_pcj_config]->{'ip'},
'RemotePort' => $self->[+_pcj_config]->{'port'},
'SuccessEvent' => 'connected',
'FailureEvent' => 'connect_error',
);
$kernel->post($self->[+_pcj_events], +PCJ_CONNECTING);
return;
}
sub _default()
{
my ($event) = $_[ARG0];
$_[OBJECT]->debug_message($event . ' was not caught');
}
sub return_to_sender()
{
my ($kernel, $self, $session, $sender, $event, $node) =
@_[KERNEL, OBJECT, SESSION, SENDER, ARG0, ARG1];
my $attrs = $node->getAttributes();
my $pid;
if(exists($attrs->{'id'}))
{
if(exists($self->[+_pcj_pending]->{$attrs->{'id'}}))
{
$self->debug_message('OVERRIDING USER DEFINED ID!');
$pid = $self->[+_pcj_id]->add(
$self->[+_pcj_id]->clone()->hexdigest())
->clone()->hexdigest();
$node->setAttribute('id', $pid);
}
$pid = $attrs->{'id'};
} else {
$pid = $self->[+_pcj_id]->add(
$self->[+_pcj_id]->clone()->hexdigest())
->clone()->hexdigest();
$node->setAttribute('id', $pid);
}
my $state = $session == $sender ? 1 : undef;
$self->[+_pcj_pending]->{$pid} = [];
$self->[+_pcj_pending]->{$pid}->[0] = $sender->ID();
$self->[+_pcj_pending]->{$pid}->[1] = $event;
$kernel->call($self->[+_pcj_events], 'publish', $event) if defined($state);
$kernel->yield('output_handler', $node, $state);
$kernel->post($self->[+_pcj_events], +PCJ_RTS_START, $node);
return;
}
sub connected()
{
my ($kernel, $self, $sock) = @_[KERNEL, OBJECT, ARG0];
$self->[+_pcj_sock] = $sock;
$self->[+_pcj_sfwheel] = undef;
my $input = $self->[+_pcj_helper]->get_input_event() ||
Carp::confess('No input event defined in helper!');
my $error = $self->[+_pcj_helper]->get_error_event();
my $flushed = $self->[+_pcj_helper]->get_flushed_event();
$kernel->state('input_handler', $self->[+_pcj_helper], $input);
$kernel->state('server_error', $self->[+_pcj_helper], $error) if $error;
$kernel->state('flushed', $self->[+_pcj_helper], $flushed) if $flushed;
$self->[+_pcj_wheel] = POE::Wheel::ReadWrite->new
(
'Handle' => $self->[+_pcj_sock],
'Filter' => POE::Filter::XML->new(),
'InputEvent' => 'input_handler',
'ErrorEvent' => 'server_error',
'FlushedEvent' => 'flushed',
);
$kernel->yield('initiate_stream');
$kernel->post($self->[+_pcj_events], +PCJ_CONNECTED);
return;
}
sub relinquish_states()
{
my $self = shift;
if($self->[+_pcj_config]->{'debug'})
{
$poe_kernel->state('input_handler', $self, 'debug_input_handler');
} else {
$poe_kernel->state('input_handler', $self, 'input_handler');
}
$poe_kernel->state('server_error', $self, 'server_error');
$poe_kernel->state('flushed', $self, 'flushed');
$self->[+_pcj_init_finished] = 1;
return;
}
sub initiate_stream()
{
my ($kernel, $self, $sender, $session) =
@_[KERNEL, OBJECT, SENDER, SESSION];
my $element = POE::Filter::XML::Node->new('stream:stream');
$element->setAttributes
(
[
'to', $self->[+_pcj_config]->{'hostname'},
'xmlns', $self->[+_pcj_config]->{'xmlns'},
'xmlns:stream', $self->[+_pcj_config]->{'stream'},
'version', $self->[+_pcj_config]->{'version'}
]
);
$element->stream_start(1);
my $state = $session == $sender ? 1 : undef;
$kernel->yield('output_handler', $element, $state);
$kernel->post($self->[+_pcj_events], +PCJ_STREAMSTART, $element);
return;
}
sub disconnected()
{
my ($kernel, $self) = @_[KERNEL, OBJECT];
$kernel->post($self->[+_pcj_events], +PCJ_SOCKETDISCONNECT);
return;
}
sub flushed()
{
my ($kernel, $self, $session) = @_[KERNEL, OBJECT, SESSION];
if($self->[+_pcj_shutdown])
{
$kernel->call($session, 'disconnected');
$kernel->post($self->[+_pcj_events], +PCJ_SHUTDOWN_FINISH);
}
return;
}
sub shutdown()
{
my ($kernel, $self) = @_[KERNEL, OBJECT];
if(defined($self->[+_pcj_wheel]))
{
my $node = POE::Filter::XML::Node->new('stream:stream');
$node->stream_end(1);
$self->[+_pcj_shutdown] = 1;
$self->[+_pcj_wheel]->put($node);
$kernel->post($self->[+_pcj_events], +PCJ_STREAMEND);
$kernel->post($self->[+_pcj_events], +PCJ_SHUTDOWN_START);
}
return;
}
sub debug_purge_queue()
{
my ($kernel, $self, $sender, $session) =
@_[KERNEL, OBJECT, SENDER, SESSION];
my $items = [];
while(my $item = shift(@{$self->[+_pcj_queue]}))
{
push(@$items, $item);
}
$self->debug_message( 'Items pulled from queue: ' . scalar(@$items));
my $state = $sender == $session ? 1 : undef;
foreach(@$items)
{
$kernel->yield('output_handler', $_, $state);
}
return;
}
sub purge_queue()
{
my ($kernel, $self, $sender, $session) =
@_[KERNEL, OBJECT, SENDER, SESSION];
my $items = [];
while(my $item = shift(@{$self->[+_pcj_queue]}))
{
push(@$items, $item);
}
my $state = $sender == $session ? 1 : undef;
foreach(@$items)
{
$kernel->yield('output_handler', $_, $state);
}
return;
}
sub debug_output_handler()
{
my ($kernel, $self, $node, $state) = @_[KERNEL, OBJECT, ARG0, ARG1];
if(defined($self->[+_pcj_wheel]))
{
if($self->[+_pcj_init_finished] || $state)
{
$self->debug_message('Sent: ' . $node->toString());
$self->[+_pcj_wheel]->put($node);
$kernel->post($self->[+_pcj_events], +PCJ_NODESENT, $node);
} else {
$self->debug_message('Still initialising.');
$self->debug_message('Queued: ' . $node->toString());
push(@{$self->[+_pcj_queue]}, $node);
$self->debug_message(
'Queued COUNT: ' . scalar(@{$self->[+_pcj_queue]}));
$kernel->post($self->[+_pcj_events], +PCJ_NODEQUEUED, $node);
}
} else {
$self->debug_message('There is no wheel present.');
$self->debug_message('Queued: ' . $node->toString());
$self->debug_message(
'Queued COUNT: ' . scalar(@{$self->[+_pcj_queue]}));
push(@{$self->[+_pcj_queue]}, $node);
$kernel->post($self->[+_pcj_events], +PCJ_SOCKETDISCONNECT);
$kernel->post($self->[+_pcj_events], +PCJ_NODEQUEUED, $node);
}
return;
}
sub output_handler()
{
my ($kernel, $self, $node, $state) = @_[KERNEL, OBJECT, ARG0, ARG1];
if(defined($self->[+_pcj_wheel]))
{
if($self->[+_pcj_init_finished] || $state)
{
$self->[+_pcj_wheel]->put($node);
$kernel->post($self->[+_pcj_events], +PCJ_NODESENT, $node);
} else {
push(@{$self->[+_pcj_queue]}, $node);
$kernel->post($self->[+_pcj_events], +PCJ_NODEQUEUED, $node);
}
} else {
push(@{$self->[+_pcj_queue]}, $node);
$kernel->post($self->[+_pcj_events], +PCJ_SOCKETDISCONNECT);
$kernel->post($self->[+_pcj_events], +PCJ_NODEQUEUED, $node);
}
return;
}
sub input_handler()
{
my ($kernel, $self, $node) = @_[KERNEL, OBJECT, ARG0];
my $attrs = $node->getAttributes();
if(exists($attrs->{'id'}))
{
if(defined($self->[+_pcj_pending]->{$attrs->{'id'}}))
{
my $array = delete $self->[+_pcj_pending]->{$attrs->{'id'}};
$kernel->post($array->[0], $array->[1], $node);
$kernel->post($self->[+_pcj_events], 'rescind', $array->[1])
if $array->[0] != $_[SESSION]->ID();
$kernel->post($self->[+_pcj_events], +PCJ_RTS_FINISH, $node);
return;
}
}
for(0..$#{$self->[+_pcj_xpathfilters]})
{
my $nodes =
[
map { ordain($_) } $node->findnodes($self->[+_pcj_xpathfilters]->[$_]->[+EXPRESSION])
];
if(@$nodes)
{
$kernel->post
(
$self->[+_pcj_events],
$self->[+_pcj_xpathfilters]->[$_]->[+EVENT],
$self->[+_pcj_xpathfilters]->[$_]->[+EXPRESSION],
$nodes,
$node
);
}
}
$kernel->post($self->[+_pcj_events], +PCJ_NODERECEIVED, $node);
return;
}
sub debug_input_handler()
{
my ($kernel, $self, $node) = @_[KERNEL, OBJECT, ARG0];
$self->debug_message("Recd: ".$node->toString());
my $attrs = $node->getAttributes();
if(exists($attrs->{'id'}))
{
if(defined($self->[+_pcj_pending]->{$attrs->{'id'}}))
{
my $array = delete $self->[+_pcj_pending]->{$attrs->{'id'}};
$kernel->post($array->[0], $array->[1], $node);
$kernel->post($self->[+_pcj_events], 'rescind', $array->[1])
if $array->[0] != $_[SESSION]->ID();
$kernel->post($self->[+_pcj_events], +PCJ_RTS_FINISH, $node);
return;
}
}
for(0..$#{$self->[+_pcj_xpathfilters]})
{
my $nodes =
[
map { ordain($_) } $node->findnodes($self->[+_pcj_xpathfilters]->[$_]->[+EXPRESSION])
];
if(@$nodes)
{
$self->debug_message('XPATH Match: '.$self->[+_pcj_xpathfilters]->[$_]->[+EXPRESSION]);
for(0..$#{$nodes})
{
$self->debug_message('XPATH Matched Node: '.$nodes->[$_]);
}
$kernel->post
(
$self->[+_pcj_events],
$self->[+_pcj_xpathfilters]->[$_]->[+EVENT],
$self->[+_pcj_xpathfilters]->[$_]->[+EXPRESSION],
$nodes,
$node
);
}
}
$kernel->post($self->[+_pcj_events], +PCJ_NODERECEIVED, $node);
return;
}
sub xpath_filter()
{
my ($kernel, $self, $cmd, $event, $xpath) =
@_[KERNEL, OBJECT, ARG0, ARG1, ARG2];
given($cmd)
{
when('add')
{
push(@{$self->[+_pcj_xpathfilters]}, [$event, $xpath]);
$kernel->post
(
$self->[+_pcj_events],
'publish',
$event
);
}
when('remove')
{
@{$self->[+_pcj_xpathfilters]} = grep { $_->[+EVENT] ne $event } @{$self->[+_pcj_xpathfilters]};
$kernel->post
(
$self->[+_pcj_events],
'recind',
$event
);
}
}
}
sub server_error()
{
my ($kernel, $self, $call, $code, $err) = @_[KERNEL, OBJECT, ARG0..ARG2];
$self->[+_pcj_wheel] = undef;
$kernel->post($self->[+_pcj_events], +PCJ_SOCKETFAIL, $call, $code, $err);
return;
}
sub debug_message()
{
my $self = shift;
warn "\n", scalar (localtime (time)), ': ' . shift(@_) ."\n";
return;
}
1;
__END__
=pod
=head1 NAME
POE::Component::Jabber - A POE Component for communicating over Jabber
=head1 VERSION
3.00
=head1 DESCRIPTION
PCJ is a communications component that fits within the POE framework and
provides the raw low level footwork of initiating a connection, negotiatating
various protocol layers, and authentication necessary for the end developer
to focus more on the business end of implementing a client or service.
=head1 METHODS
=over 4
=item new()
Accepts many named, required arguments which are listed below. new() will
return a reference to the newly created reference to a PCJ object and should
be stored. There are many useful methods that can be called on the object to
gather various bits of information such as your negotiated JID.
=over 2
=item IP
The IP address in dotted quad, or the FQDN for the server.
=item PORT
The remote port of the server to connect.
=item HOSTNAME
The hostname of the server. Used in addressing.
=item USERNAME
The username to be used in authentication (OPTIONAL for jabberd14 service
connections).
=item PASSWORD
The password to be used in authentication.
=item RESOURCE
The resource that will be used for binding and session establishment
(OPTIONAL: resources aren't necessary for initialization of service oriented
connections, and if not provided for client connections will be automagically
generated).
=item ALIAS
The alias the component should register for use within POE. Defaults to
the class name.
=item CONNECTIONTYPE
This is the type of connection you wish to esablish. There four possible types
available for use. One must be selected. Each item is exported by default.
=over 2
=item XMPP (XMPP.pm)
This connection type is for use with XMPP 1.0 compliant servers. It implements
all of the necessary functionality for TLS, binding, and session negotiation.
=item LEGACY (Legacy.pm)
LEGACY is for use with pre-XMPP Jabber servers. It uses the old style
authentication and non-secured socket communication.
=item JABBERD14_COMPONENT (J14.pm)
Use this connection type if designing a backbone level component for a server
that implements XEP-114 for router level communication.
=item JABBERD20_COMPONENT (J2.pm)
If making a router level connection to the jabberd2 server, use this
connection type. It implements the modified XMPP protocol, which does most of
it except the session negotiation.
=back
Each connection type has a corresponding module. See their respective
documentation for more information each protocol dialect.
=item VERSION
If for whatever reason you want to override the protocol version gathered from
your ConnectionType, this is the place to do it. Please understand that this
value SHOULD NOT be altered, but it is documented here just in case.
=item XMLNS
If for whatever reason you want to override the protocol's default XML
namespace that is gathered from your ConnectionType, use this variable. Please
understand that this value SHOULD NOT be altered, but is documented here just
in case.
=item STREAM
If for whatever reason you want to override the xmlns:stream attribute in the
this is the argument to use. This SHOULD NOT ever need to be
altered, but it is available and documented just in case.
=item DEBUG
If bool true, will enable debugging and tracing within the component. All XML
sent or received through the component will be printed to STDERR
=back
=item wheel() [Protected]
wheel() returns the currently stored POE::Wheel reference. If provided an
argument, that argument will replace the current POE::Wheel stored.
=item sock() [Protected]
sock() returns the current socket being used for communication. If provided an
argument, that argument will replace the current socket stored.
=item sid() [Protected]
sid() returns the session ID that was given by the server upon the initial
connection. If provided an argument, that argument will replace the current
session id stored.
=item config() [Protected]
config() returns the configuration structure (HASH reference) of PCJ that is
used internally. It contains values that are either defaults or were
calculated based on arguments provided in the constructor. If provided an
argument, that argument will replace the current configuration.
=item pending() [Protected]
pending() returns a hash reference to the currently pending return_to_sender
transactions keyed by the 'id' attribute of the XML node. If provided an
argument, that argument will replace the pending queue.
=item queue() [Protected]
queue() returns an array reference containing the Nodes sent when there was
no suitable initialized connection available. Index zero is the first Node
placed into the queue with index one being the second, and so on. See under
the EVENTS section, 'purge_queue' for more information.
=item _reset() [Private]
_reset() returns PCJ back to its initial state and returns nothing.
=item _gather_options() [Private]
_gather_options() takes an array reference of the arguments provided to new()
(ie. \@_) and populates its internal configuration with the values (the same
configuration returned by config()).
=item relinquish_states() [Protected]
relinquish_states() is used by Protocol subclasses to return control of the
events back to the core of PCJ. It is typically called when the event
PCJ_READY is fired to the events handler.
=back
=head1 PUBLISHED INPUT EVENTS
=over 4
=item 'output'
This is the event that you use to push data over the wire. It accepts only one
argument, a reference to a POE::Filter::XML::Node.
=item 'return_to_sender'
This event takes (1) a POE::Filter::XML::Node and gives it a unique id, and
(2) a return event and places it in the state machine. Upon receipt of
response to the request, the return event is fired with the response packet.
POE::Component::Jabber will publish the return event upon receipt, and rescind
the event once the the return event is fired.
In the context POE::Component::PubSub, this means that a subscription must
exist to the return event. Subscriptions can be made prior to publishing.
Please note that return_to_sender short circuits before XPATH filter and normal
node received events.
=item 'xpath_filter'
This event takes (1) a command of either 'add' or 'remove', (2) and event name
to be called upon a successful match, and (3) an XPATH expression.
With 'add', all three arguments are required. With 'remove', only the event
name is required.
Like return_to_sender, POE::Component::Jabber will publish the return event
upon receipt, but will NOT rescind once the filter matches something. This
allows for persistent filters and event dispatching.
Every filter is evaluated for every packet (if not applicable to
return_to_sender processing), allowing multiple overlapping filters. And event
names are not checked to be unique, so be careful when adding filters that go
to the same event, because 'remove' will remove all instances of that
particular event.
=item 'shutdown'
The shutdown event terminates the XML stream which in turn will trigger the
end of the socket's life.
=item 'connect' and 'reconnect'
This event can take (1) the ip address of a new server and (2) the port. This
event may also be called without any arguments and it will force the component
to [re]connect.
This event must be posted before the component will initiate a connection.
=item 'purge_queue'
If Nodes are sent to the output event when there isn't a fully initialized
connection, the Nodes are placed into a queue. PCJ will not automatically purge
this queue when a suitable connection DOES become available because there is no
way to tell if the packets are still valid or not. It is up to the end
developer to decide this and fire this event. Packets will be sent in the order
in which they were received.
=back
=head1 PUBLISHED OUTPUT EVENTS
Please see POE::Component::Jabber::Events for a list of published events to
which subscriptions can be made.
=head1 CHANGES
From the 2.X branch, several changes have been made improve event
management.
The guts are now based around POE::Component::PubSub. This enables very
specific subscriptions to status events rather than all of the status
events being delivered to a single event.
Also, using the new POE::Filter::XML means that the underlying XML parser
and Node implementation has changed for the better but also introduced
API incompatibilities. For the most part, a simple search-and-replace
will suffice. Well worth it for the power to apply XPATH expressions to
nodes.
=head1 NOTES
This is a connection broker. This should not be considered a first class
client or service. This broker basically implements whatever core
functionality is required to get the end developer to the point of writing
upper level functionality quickly.
=head1 EXAMPLES
For example implementations using all four current aspects, please see the
examples/ directory in the distribution.
=head1 AUTHOR
Copyright (c) 2003-2009 Nicholas Perez. Distributed under the GPL.
=cut
POE-Component-Jabber-3.00/LICENSE 0000555 0001750 0001750 00000035660 11161375731 016411 0 ustar nicholas nicholas Unless otherwise noted with in the source file all source code contained
within this product is subject to the GNU GPL listed below.
GNU GENERAL PUBLIC LICENSE
Version 2, June 1991
Copyright (C) 1989, 1991 Free Software Foundation, Inc.
59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
Everyone is permitted to copy and distribute verbatim copies
of this license document, but changing it is not allowed.
Preamble
The licenses for most software are designed to take away your
freedom to share and change it. By contrast, the GNU General Public
License is intended to guarantee your freedom to share and change free
software--to make sure the software is free for all its users. This
General Public License applies to most of the Free Software
Foundation's software and to any other program whose authors commit to
using it. (Some other Free Software Foundation software is covered by
the GNU Library General Public License instead.) You can apply it to
your programs, too.
When we speak of free software, we are referring to freedom, not
price. Our General Public Licenses are designed to make sure that you
have the freedom to distribute copies of free software (and charge for
this service if you wish), that you receive source code or can get it
if you want it, that you can change the software or use pieces of it
in new free programs; and that you know you can do these things.
To protect your rights, we need to make restrictions that forbid
anyone to deny you these rights or to ask you to surrender the rights.
These restrictions translate to certain responsibilities for you if you
distribute copies of the software, or if you modify it.
For example, if you distribute copies of such a program, whether
gratis or for a fee, you must give the recipients all the rights that
you have. You must make sure that they, too, receive or can get the
source code. And you must show them these terms so they know their
rights.
We protect your rights with two steps: (1) copyright the software, and
(2) offer you this license which gives you legal permission to copy,
distribute and/or modify the software.
Also, for each author's protection and ours, we want to make certain
that everyone understands that there is no warranty for this free
software. If the software is modified by someone else and passed on, we
want its recipients to know that what they have is not the original, so
that any problems introduced by others will not reflect on the original
authors' reputations.
Finally, any free program is threatened constantly by software
patents. We wish to avoid the danger that redistributors of a free
program will individually obtain patent licenses, in effect making the
program proprietary. To prevent this, we have made it clear that any
patent must be licensed for everyone's free use or not licensed at all.
The precise terms and conditions for copying, distribution and
modification follow.
GNU GENERAL PUBLIC LICENSE
TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
0. This License applies to any program or other work which contains
a notice placed by the copyright holder saying it may be distributed
under the terms of this General Public License. The "Program", below,
refers to any such program or work, and a "work based on the Program"
means either the Program or any derivative work under copyright law:
that is to say, a work containing the Program or a portion of it,
either verbatim or with modifications and/or translated into another
language. (Hereinafter, translation is included without limitation in
the term "modification".) Each licensee is addressed as "you".
Activities other than copying, distribution and modification are not
covered by this License; they are outside its scope. The act of
running the Program is not restricted, and the output from the Program
is covered only if its contents constitute a work based on the
Program (independent of having been made by running the Program).
Whether that is true depends on what the Program does.
1. You may copy and distribute verbatim copies of the Program's
source code as you receive it, in any medium, provided that you
conspicuously and appropriately publish on each copy an appropriate
copyright notice and disclaimer of warranty; keep intact all the
notices that refer to this License and to the absence of any warranty;
and give any other recipients of the Program a copy of this License
along with the Program.
You may charge a fee for the physical act of transferring a copy, and
you may at your option offer warranty protection in exchange for a fee.
2. You may modify your copy or copies of the Program or any portion
of it, thus forming a work based on the Program, and copy and
distribute such modifications or work under the terms of Section 1
above, provided that you also meet all of these conditions:
a) You must cause the modified files to carry prominent notices
stating that you changed the files and the date of any change.
b) You must cause any work that you distribute or publish, that in
whole or in part contains or is derived from the Program or any
part thereof, to be licensed as a whole at no charge to all third
parties under the terms of this License.
c) If the modified program normally reads commands interactively
when run, you must cause it, when started running for such
interactive use in the most ordinary way, to print or display an
announcement including an appropriate copyright notice and a
notice that there is no warranty (or else, saying that you provide
a warranty) and that users may redistribute the program under
these conditions, and telling the user how to view a copy of this
License. (Exception: if the Program itself is interactive but
does not normally print such an announcement, your work based on
the Program is not required to print an announcement.)
These requirements apply to the modified work as a whole. If
identifiable sections of that work are not derived from the Program,
and can be reasonably considered independent and separate works in
themselves, then this License, and its terms, do not apply to those
sections when you distribute them as separate works. But when you
distribute the same sections as part of a whole which is a work based
on the Program, the distribution of the whole must be on the terms of
this License, whose permissions for other licensees extend to the
entire whole, and thus to each and every part regardless of who wrote it.
Thus, it is not the intent of this section to claim rights or contest
your rights to work written entirely by you; rather, the intent is to
exercise the right to control the distribution of derivative or
collective works based on the Program.
In addition, mere aggregation of another work not based on the Program
with the Program (or with a work based on the Program) on a volume of
a storage or distribution medium does not bring the other work under
the scope of this License.
3. You may copy and distribute the Program (or a work based on it,
under Section 2) in object code or executable form under the terms of
Sections 1 and 2 above provided that you also do one of the following:
a) Accompany it with the complete corresponding machine-readable
source code, which must be distributed under the terms of Sections
1 and 2 above on a medium customarily used for software interchange; or,
b) Accompany it with a written offer, valid for at least three
years, to give any third party, for a charge no more than your
cost of physically performing source distribution, a complete
machine-readable copy of the corresponding source code, to be
distributed under the terms of Sections 1 and 2 above on a medium
customarily used for software interchange; or,
c) Accompany it with the information you received as to the offer
to distribute corresponding source code. (This alternative is
allowed only for noncommercial distribution and only if you
received the program in object code or executable form with such
an offer, in accord with Subsection b above.)
The source code for a work means the preferred form of the work for
making modifications to it. For an executable work, complete source
code means all the source code for all modules it contains, plus any
associated interface definition files, plus the scripts used to
control compilation and installation of the executable. However, as a
special exception, the source code distributed need not include
anything that is normally distributed (in either source or binary
form) with the major components (compiler, kernel, and so on) of the
operating system on which the executable runs, unless that component
itself accompanies the executable.
If distribution of executable or object code is made by offering
access to copy from a designated place, then offering equivalent
access to copy the source code from the same place counts as
distribution of the source code, even though third parties are not
compelled to copy the source along with the object code.
4. You may not copy, modify, sublicense, or distribute the Program
except as expressly provided under this License. Any attempt
otherwise to copy, modify, sublicense or distribute the Program is
void, and will automatically terminate your rights under this License.
However, parties who have received copies, or rights, from you under
this License will not have their licenses terminated so long as such
parties remain in full compliance.
5. You are not required to accept this License, since you have not
signed it. However, nothing else grants you permission to modify or
distribute the Program or its derivative works. These actions are
prohibited by law if you do not accept this License. Therefore, by
modifying or distributing the Program (or any work based on the
Program), you indicate your acceptance of this License to do so, and
all its terms and conditions for copying, distributing or modifying
the Program or works based on it.
6. Each time you redistribute the Program (or any work based on the
Program), the recipient automatically receives a license from the
original licensor to copy, distribute or modify the Program subject to
these terms and conditions. You may not impose any further
restrictions on the recipients' exercise of the rights granted herein.
You are not responsible for enforcing compliance by third parties to
this License.
7. If, as a consequence of a court judgment or allegation of patent
infringement or for any other reason (not limited to patent issues),
conditions are imposed on you (whether by court order, agreement or
otherwise) that contradict the conditions of this License, they do not
excuse you from the conditions of this License. If you cannot
distribute so as to satisfy simultaneously your obligations under this
License and any other pertinent obligations, then as a consequence you
may not distribute the Program at all. For example, if a patent
license would not permit royalty-free redistribution of the Program by
all those who receive copies directly or indirectly through you, then
the only way you could satisfy both it and this License would be to
refrain entirely from distribution of the Program.
If any portion of this section is held invalid or unenforceable under
any particular circumstance, the balance of the section is intended to
apply and the section as a whole is intended to apply in other
circumstances.
It is not the purpose of this section to induce you to infringe any
patents or other property right claims or to contest validity of any
such claims; this section has the sole purpose of protecting the
integrity of the free software distribution system, which is
implemented by public license practices. Many people have made
generous contributions to the wide range of software distributed
through that system in reliance on consistent application of that
system; it is up to the author/donor to decide if he or she is willing
to distribute software through any other system and a licensee cannot
impose that choice.
This section is intended to make thoroughly clear what is believed to
be a consequence of the rest of this License.
8. If the distribution and/or use of the Program is restricted in
certain countries either by patents or by copyrighted interfaces, the
original copyright holder who places the Program under this License
may add an explicit geographical distribution limitation excluding
those countries, so that distribution is permitted only in or among
countries not thus excluded. In such case, this License incorporates
the limitation as if written in the body of this License.
9. The Free Software Foundation may publish revised and/or new versions
of the General Public License from time to time. Such new versions will
be similar in spirit to the present version, but may differ in detail to
address new problems or concerns.
Each version is given a distinguishing version number. If the Program
specifies a version number of this License which applies to it and "any
later version", you have the option of following the terms and conditions
either of that version or of any later version published by the Free
Software Foundation. If the Program does not specify a version number of
this License, you may choose any version ever published by the Free Software
Foundation.
10. If you wish to incorporate parts of the Program into other free
programs whose distribution conditions are different, write to the author
to ask for permission. For software which is copyrighted by the Free
Software Foundation, write to the Free Software Foundation; we sometimes
make exceptions for this. Our decision will be guided by the two goals
of preserving the free status of all derivatives of our free software and
of promoting the sharing and reuse of software generally.
NO WARRANTY
11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED
OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS
TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE
PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,
REPAIR OR CORRECTION.
12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,
INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING
OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED
TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY
YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER
PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE
POSSIBILITY OF SUCH DAMAGES.
END OF TERMS AND CONDITIONS
POE-Component-Jabber-3.00/README 0000444 0001750 0001750 00000023425 11161375731 016255 0 ustar nicholas nicholas NAME
POE::Component::Jabber - A POE Component for communicating over Jabber
VERSION
3.00
DESCRIPTION
PCJ is a communications component that fits within the POE framework and
provides the raw low level footwork of initiating a connection,
negotiatating various protocol layers, and authentication necessary for
the end developer to focus more on the business end of implementing a
client or service.
METHODS
new()
Accepts many named, required arguments which are listed below. new()
will return a reference to the newly created reference to a PCJ
object and should be stored. There are many useful methods that can
be called on the object to gather various bits of information such
as your negotiated JID.
IP
The IP address in dotted quad, or the FQDN for the server.
PORT
The remote port of the server to connect.
HOSTNAME
The hostname of the server. Used in addressing.
USERNAME
The username to be used in authentication (OPTIONAL for jabberd14
service connections).
PASSWORD
The password to be used in authentication.
RESOURCE
The resource that will be used for binding and session
establishment (OPTIONAL: resources aren't necessary for
initialization of service oriented connections, and if not
provided for client connections will be automagically generated).
ALIAS
The alias the component should register for use within POE.
Defaults to the class name.
CONNECTIONTYPE
This is the type of connection you wish to esablish. There four
possible types available for use. One must be selected. Each item
is exported by default.
XMPP (XMPP.pm)
This connection type is for use with XMPP 1.0 compliant servers.
It implements all of the necessary functionality for TLS,
binding, and session negotiation.
LEGACY (Legacy.pm)
LEGACY is for use with pre-XMPP Jabber servers. It uses the old
style authentication and non-secured socket communication.
JABBERD14_COMPONENT (J14.pm)
Use this connection type if designing a backbone level component
for a server that implements XEP-114 for router level
communication.
JABBERD20_COMPONENT (J2.pm)
If making a router level connection to the jabberd2 server, use
this connection type. It implements the modified XMPP protocol,
which does most of it except the session negotiation.
Each connection type has a corresponding module. See their
respective documentation for more information each protocol
dialect.
VERSION
If for whatever reason you want to override the protocol version
gathered from your ConnectionType, this is the place to do it.
Please understand that this value SHOULD NOT be altered, but it is
documented here just in case.
XMLNS
If for whatever reason you want to override the protocol's default
XML namespace that is gathered from your ConnectionType, use this
variable. Please understand that this value SHOULD NOT be altered,
but is documented here just in case.
STREAM
If for whatever reason you want to override the xmlns:stream
attribute in the this is the argument to use.
This SHOULD NOT ever need to be altered, but it is available and
documented just in case.
DEBUG
If bool true, will enable debugging and tracing within the
component. All XML sent or received through the component will be
printed to STDERR
wheel() [Protected]
wheel() returns the currently stored POE::Wheel reference. If
provided an argument, that argument will replace the current
POE::Wheel stored.
sock() [Protected]
sock() returns the current socket being used for communication. If
provided an argument, that argument will replace the current socket
stored.
sid() [Protected]
sid() returns the session ID that was given by the server upon the
initial connection. If provided an argument, that argument will
replace the current session id stored.
config() [Protected]
config() returns the configuration structure (HASH reference) of PCJ
that is used internally. It contains values that are either defaults
or were calculated based on arguments provided in the constructor.
If provided an argument, that argument will replace the current
configuration.
pending() [Protected]
pending() returns a hash reference to the currently pending
return_to_sender transactions keyed by the 'id' attribute of the XML
node. If provided an argument, that argument will replace the
pending queue.
queue() [Protected]
queue() returns an array reference containing the Nodes sent when
there was no suitable initialized connection available. Index zero
is the first Node placed into the queue with index one being the
second, and so on. See under the EVENTS section, 'purge_queue' for
more information.
_reset() [Private]
_reset() returns PCJ back to its initial state and returns nothing.
_gather_options() [Private]
_gather_options() takes an array reference of the arguments provided
to new() (ie. \@_) and populates its internal configuration with the
values (the same configuration returned by config()).
relinquish_states() [Protected]
relinquish_states() is used by Protocol subclasses to return control
of the events back to the core of PCJ. It is typically called when
the event PCJ_READY is fired to the events handler.
PUBLISHED INPUT EVENTS
'output'
This is the event that you use to push data over the wire. It
accepts only one argument, a reference to a POE::Filter::XML::Node.
'return_to_sender'
This event takes (1) a POE::Filter::XML::Node and gives it a unique
id, and (2) a return event and places it in the state machine. Upon
receipt of response to the request, the return event is fired with
the response packet.
POE::Component::Jabber will publish the return event upon receipt,
and rescind the event once the the return event is fired.
In the context POE::Component::PubSub, this means that a
subscription must exist to the return event. Subscriptions can be
made prior to publishing.
Please note that return_to_sender short circuits before XPATH filter
and normal node received events.
'xpath_filter'
This event takes (1) a command of either 'add' or 'remove', (2) and
event name to be called upon a successful match, and (3) an XPATH
expression.
With 'add', all three arguments are required. With 'remove', only
the event name is required.
Like return_to_sender, POE::Component::Jabber will publish the
return event upon receipt, but will NOT rescind once the filter
matches something. This allows for persistent filters and event
dispatching.
Every filter is evaluated for every packet (if not applicable to
return_to_sender processing), allowing multiple overlapping filters.
And event names are not checked to be unique, so be careful when
adding filters that go to the same event, because 'remove' will
remove all instances of that particular event.
'shutdown'
The shutdown event terminates the XML stream which in turn will
trigger the end of the socket's life.
'connect' and 'reconnect'
This event can take (1) the ip address of a new server and (2) the
port. This event may also be called without any arguments and it
will force the component to [re]connect.
This event must be posted before the component will initiate a
connection.
'purge_queue'
If Nodes are sent to the output event when there isn't a fully
initialized connection, the Nodes are placed into a queue. PCJ will
not automatically purge this queue when a suitable connection DOES
become available because there is no way to tell if the packets are
still valid or not. It is up to the end developer to decide this and
fire this event. Packets will be sent in the order in which they
were received.
PUBLISHED OUTPUT EVENTS
Please see POE::Component::Jabber::Events for a list of published events
to which subscriptions can be made.
CHANGES
From the 2.X branch, several changes have been made improve event
management.
The guts are now based around POE::Component::PubSub. This enables very
specific subscriptions to status events rather than all of the status
events being delivered to a single event.
Also, using the new POE::Filter::XML means that the underlying XML
parser and Node implementation has changed for the better but also
introduced API incompatibilities. For the most part, a simple
search-and-replace will suffice. Well worth it for the power to apply
XPATH expressions to nodes.
NOTES
This is a connection broker. This should not be considered a first class
client or service. This broker basically implements whatever core
functionality is required to get the end developer to the point of
writing upper level functionality quickly.
EXAMPLES
For example implementations using all four current aspects, please see
the examples/ directory in the distribution.
AUTHOR
Copyright (c) 2003-2009 Nicholas Perez. Distributed under the GPL.
POE-Component-Jabber-3.00/Build.PL 0000444 0001750 0001750 00000005312 11161375731 016664 0 ustar nicholas nicholas use warnings;
use strict;
use Module::Build;
my $prompt = 'Would you like to enable network tests?';
my $prompt_components =
qq| If you would like to test the jabberd14 and jabberd20 component connection \n|.
qq| facilities, you will need to have already configured both servers to accept \n|.
qq| connections. If this sounds like a hassle please answer 'N' to the \n|.
qq| following question. \n\nDo you want to enable tests for jabberd14 and \n|.
qq| jabberd20 component connections?|;
my $j14 = qq|### JABBERD14 ###\n|;
my $j20 = qq|### JABBERD20 ###\n|;
my @comps = ($j14, $j20);
my $prompt_ip = 'Please enter the ip address of the server.';
my $prompt_port = 'Please enter the listening port on the server.';
my $prompt_hostname = 'Please enter the hostname the component will represent.';
my $prompt_username = qq|Please enter the username the component will represent.|;
my $prompt_secret = 'Please enter the secret that will be used to auth.';
my $ret;
if (grep /^--default$/, @ARGV) {
print $prompt, " [n] n\n\n";
} else {
$ret = Module::Build->prompt($prompt, 'n');
}
if($ret =~ /^y/i)
{
open(my $file, '>', 'run_network_tests');
$ret = Module::Build->prompt($prompt_components, 'n');
if($ret =~ /^y/i)
{
print "\n" . qq|### JABBERD14 ###\n|;
print $file qq|### JABBERD14 ###\n|;
print $file 'IP=' . Module::Build->prompt($prompt_ip, '127.0.0.1') . "\n";
print $file 'PORT=' . Module::Build->prompt($prompt_port, '5348') . "\n";
print $file 'HOST=' . Module::Build->prompt($prompt_hostname, 'component.localhost') . "\n";
print $file 'SECRET=' . Module::Build->prompt($prompt_secret, 'secret') . "\n";
print "\n" . qq|### JABBERD20 ###\n|;
print $file qq|### JABBERD20 ###\n|;
print $file 'IP=' . Module::Build->prompt($prompt_ip, '127.0.0.1') . "\n";
print $file 'PORT=' . Module::Build->prompt($prompt_port, '5347') . "\n";
print $file 'HOST=' . Module::Build->prompt($prompt_hostname, 'component.localhost') . "\n";
print $file 'USER=' . Module::Build->prompt($prompt_username, 'jabberd') . "\n";
print $file 'SECRET=' . Module::Build->prompt($prompt_secret, 'secret') . "\n";
}
close($file);
} else {
unlink 'run_network_tests' if -e 'run_network_tests';
}
Module::Build->new
(
'module_name' => 'POE::Component::Jabber',
'license' => 'gpl',
'create_makefile_pl' => 'passthrough',
'create_readme' => 1,
'requires' =>
{
'perl' => '5.10.0',
'POE' => '1.003',
'Digest::SHA1' => '2.11',
'Authen::SASL' => '2.12',
'MIME::Base64' => '3.07_01',
'POE::Filter::XML' => '0.35',
'POE::Component::SSLify' => '0.15',
'POE::Component::PubSub' => '0.05',
}
)->create_build_script();
POE-Component-Jabber-3.00/Makefile.PL 0000444 0001750 0001750 00000002142 11161375731 017340 0 ustar nicholas nicholas # Note: this file was auto-generated by Module::Build::Compat version 0.2808_01
require 5.10.0;
unless (eval "use Module::Build::Compat 0.02; 1" ) {
print "This module requires Module::Build to install itself.\n";
require ExtUtils::MakeMaker;
my $yn = ExtUtils::MakeMaker::prompt
(' Install Module::Build now from CPAN?', 'y');
unless ($yn =~ /^y/i) {
die " *** Cannot install without Module::Build. Exiting ...\n";
}
require Cwd;
require File::Spec;
require CPAN;
# Save this 'cause CPAN will chdir all over the place.
my $cwd = Cwd::cwd();
CPAN::Shell->install('Module::Build::Compat');
CPAN::Shell->expand("Module", "Module::Build::Compat")->uptodate
or die "Couldn't install Module::Build, giving up.\n";
chdir $cwd or die "Cannot chdir() back to $cwd: $!";
}
eval "use Module::Build::Compat 0.02; 1" or die $@;
Module::Build::Compat->run_build_pl(args => \@ARGV);
require Module::Build;
Module::Build::Compat->write_makefile(build_class => 'Module::Build');
POE-Component-Jabber-3.00/META.yml 0000444 0001750 0001750 00000002416 11161375731 016643 0 ustar nicholas nicholas ---
name: POE-Component-Jabber
version: 3.00
author: []
abstract: A POE Component for communicating over Jabber
license: gpl
resources:
license: http://opensource.org/licenses/gpl-license.php
requires:
Authen::SASL: 2.12
Digest::SHA1: 2.11
MIME::Base64: 3.07_01
POE: 1.003
POE::Component::PubSub: 0.05
POE::Component::SSLify: 0.15
POE::Filter::XML: 0.35
perl: 5.10.0
provides:
POE::Component::Jabber:
file: lib/POE/Component/Jabber.pm
version: 3.00
POE::Component::Jabber::Events:
file: lib/POE/Component/Jabber/Events.pm
version: 3.00
POE::Component::Jabber::J14:
file: lib/POE/Component/Jabber/J14.pm
version: 3.00
POE::Component::Jabber::J2:
file: lib/POE/Component/Jabber/J2.pm
version: 3.00
POE::Component::Jabber::Legacy:
file: lib/POE/Component/Jabber/Legacy.pm
version: 3.00
POE::Component::Jabber::Protocol:
file: lib/POE/Component/Jabber/Protocol.pm
version: 3.00
POE::Component::Jabber::ProtocolFactory:
file: lib/POE/Component/Jabber/ProtocolFactory.pm
version: 3.00
POE::Component::Jabber::XMPP:
file: lib/POE/Component/Jabber/XMPP.pm
version: 3.00
generated_by: Module::Build version 0.280801
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.2.html
version: 1.2
POE-Component-Jabber-3.00/examples/ 0000755 0001750 0001750 00000000000 11161375731 017207 5 ustar nicholas nicholas POE-Component-Jabber-3.00/examples/LegacyClient 0000444 0001750 0001750 00000013262 11161375731 021477 0 ustar nicholas nicholas #!/usr/bin/perl
###############################################################################
#
# LegacyClient Example
# (c) Nicholas Perez 2006 - 2009.
# Licensed under GPLv2
#
# Please see the included
# LICENSE file for details
#
# This example client script, instantiates a single PCJ object, connects to a
# remote server, sends presence, and then begins sending messages to itself on
# a small random interval
#
###############################################################################
use warnings;
use strict;
use 5.010;
use POE; #include POE constants
use POE::Component::Jabber; #include PCJ
use POE::Filter::XML::Node; #include to build nodes
use Carp;
# First we create our own session within POE to interact with PCJ
POE::Session->create(
options => { debug => 1, trace => 1},
inline_states => {
_start =>
sub
{
my ($kernel, $heap) = @_[KERNEL, HEAP];
$kernel->alias_set('Tester');
# Our PCJ instance is a fullblown object we should store
# so we can access various bits of data during use
$heap->{'component'} =
POE::Component::Jabber->new(
IP => 'localhost',
Port => '5222',
Hostname => 'localhost',
Username => 'test01',
Password => 'test01',
Alias => 'COMPONENT',
# Shown below are the various connection types included
# from POE::Component::Jabber:
# LEGACY is for pre-XMPP/Jabber connections
# XMPP is for XMPP1.0 compliant connections
# JABBERD14_COMPONENT is for connecting as a service on the
# backbone of a jabberd1.4.x server
# JABBERD20_COMPONENT is for connecting as a service on the
# backbone of a jabberd2.0.x server
ConnectionType => +LEGACY,
#ConnectionType => +XMPP,
#ConnectionType => +JABBERD14_COMPONENT,
#ConnectionType => +JABBERD20_COMPONENT,
Debug => '1',
);
# POE::Component::Jabber now uses POE::Component::PubSub to
# manage event reporting including incoming packets. So in order
# to get anything out of POE::Component::Jabber we need to
# subscribe to the various events of which we have interest.
# You can see a whole list of potential events (including
# possible error states, but seeing the
# POE::Component::Jabber::Events documentation.
# PCJ_READY: Let's us know the connection is up and all of the
# various layers of the protocol have been established.
$kernel->post('COMPONENT', 'subscribe', +PCJ_READY, 'MyReadyEvent');
# PCJ_NODERECEIVED: Fires everytime we get a node down the pipe
$kernel->post('COMPONENT', 'subscribe', +PCJ_NODERECEIVED, 'MyReceivedEvent');
# We could subscribe to all of the various error conditions or
# even all of the various steps along the way so we could
# report the status of the connection as it is building. But
# for simplicity sake, this example will only cover the bare
# minimum to get a connection up and running.
# At this point, we have subscribed to the events we want and
# are ready to tell the component to connect to the server
$kernel->post('COMPONENT', 'connect');
},
_stop =>
sub
{
$_[KERNEL]->alias_remove('Tester');
},
# This is the event with used to subscribe to the PCJ_READY event.
# It will fire anytime a connection is fully initialized and ready for
# use. It passes no arguments.
MyReadyEvent =>
sub
{
say '--- Connection is ready for use! ---';
# Now will we will send presence
my $presence = POE::Filter::XML::Node->new('presence');
# The stored POE::Component::Jabber object has a number of
# useful methods we can use outside of POE event posting,
# including jid()
$presence->setAttribute('from', $_[HEAP]->{'component'}->jid());
# Some of the event names have changed since the 2.x series.
# 'output_handler' was replaced by plain old 'output'
$_[KERNEL]->post('COMPONENT', 'output', $presence);
# Now let's send ourselves some messages
$_[KERNEL]->yield('MyMessageSendEvent');
},
# This is our event with which we subscribed to the PCJ_NODERECEIVED
# event. Once the connection is up and running, our event will be
# called once for every node received. ARG0 will contain the node
MyReceivedEvent =>
sub
{
say '--- Node received! ---';
say $_[ARG0]->toString();
say '----------------------';
},
# This is the event we call from our ready event to start send messages
# to us.
MyMessageSendEvent =>
sub
{
my $message = POE::Filter::XML::Node->new
(
'message',
[
'to', $_[HEAP]->{'component'}->jid()
]
);
$_[KERNEL]->post('COMPONENT', 'output', $message);
$_[KERNEL]->delay_set('MyMessageSendEvent', int(rand(6)));
},
}
);
POE::Kernel->run();
exit 0;
POE-Component-Jabber-3.00/examples/XMPPClient 0000444 0001750 0001750 00000013260 11161375731 021055 0 ustar nicholas nicholas #!/usr/bin/perl
###############################################################################
#
# XMPPClient Example
# (c) Nicholas Perez 2006 - 2009.
# Licensed under GPLv2
#
# Please see the included
# LICENSE file for details
#
# This example client script, instantiates a single PCJ object, connects to a
# remote server, sends presence, and then begins sending messages to itself on
# a small random interval
#
###############################################################################
use warnings;
use strict;
use 5.010;
use POE; #include POE constants
use POE::Component::Jabber; #include PCJ
use POE::Filter::XML::Node; #include to build nodes
use Carp;
# First we create our own session within POE to interact with PCJ
POE::Session->create(
options => { debug => 1, trace => 1},
inline_states => {
_start =>
sub
{
my ($kernel, $heap) = @_[KERNEL, HEAP];
$kernel->alias_set('Tester');
# Our PCJ instance is a fullblown object we should store
# so we can access various bits of data during use
$heap->{'component'} =
POE::Component::Jabber->new(
IP => 'localhost',
Port => '5222',
Hostname => 'localhost',
Username => 'test01',
Password => 'test01',
Alias => 'COMPONENT',
# Shown below are the various connection types included
# from POE::Component::Jabber:
# LEGACY is for pre-XMPP/Jabber connections
# XMPP is for XMPP1.0 compliant connections
# JABBERD14_COMPONENT is for connecting as a service on the
# backbone of a jabberd1.4.x server
# JABBERD20_COMPONENT is for connecting as a service on the
# backbone of a jabberd2.0.x server
#ConnectionType => +LEGACY,
ConnectionType => +XMPP,
#ConnectionType => +JABBERD14_COMPONENT,
#ConnectionType => +JABBERD20_COMPONENT,
Debug => '1',
);
# POE::Component::Jabber now uses POE::Component::PubSub to
# manage event reporting including incoming packets. So in order
# to get anything out of POE::Component::Jabber we need to
# subscribe to the various events of which we have interest.
# You can see a whole list of potential events (including
# possible error states, but seeing the
# POE::Component::Jabber::Events documentation.
# PCJ_READY: Let's us know the connection is up and all of the
# various layers of the protocol have been established.
$kernel->post('COMPONENT', 'subscribe', +PCJ_READY, 'MyReadyEvent');
# PCJ_NODERECEIVED: Fires everytime we get a node down the pipe
$kernel->post('COMPONENT', 'subscribe', +PCJ_NODERECEIVED, 'MyReceivedEvent');
# We could subscribe to all of the various error conditions or
# even all of the various steps along the way so we could
# report the status of the connection as it is building. But
# for simplicity sake, this example will only cover the bare
# minimum to get a connection up and running.
# At this point, we have subscribed to the events we want and
# are ready to tell the component to connect to the server
$kernel->post('COMPONENT', 'connect');
},
_stop =>
sub
{
$_[KERNEL]->alias_remove('Tester');
},
# This is the event with used to subscribe to the PCJ_READY event.
# It will fire anytime a connection is fully initialized and ready for
# use. It passes no arguments.
MyReadyEvent =>
sub
{
say '--- Connection is ready for use! ---';
# Now will we will send presence
my $presence = POE::Filter::XML::Node->new('presence');
# The stored POE::Component::Jabber object has a number of
# useful methods we can use outside of POE event posting,
# including jid()
$presence->setAttribute('from', $_[HEAP]->{'component'}->jid());
# Some of the event names have changed since the 2.x series.
# 'output_handler' was replaced by plain old 'output'
$_[KERNEL]->post('COMPONENT', 'output', $presence);
# Now let's send ourselves some messages
$_[KERNEL]->yield('MyMessageSendEvent');
},
# This is our event with which we subscribed to the PCJ_NODERECEIVED
# event. Once the connection is up and running, our event will be
# called once for every node received. ARG0 will contain the node
MyReceivedEvent =>
sub
{
say '--- Node received! ---';
say $_[ARG0]->toString();
say '----------------------';
},
# This is the event we call from our ready event to start send messages
# to us.
MyMessageSendEvent =>
sub
{
my $message = POE::Filter::XML::Node->new
(
'message',
[
'to', $_[HEAP]->{'component'}->jid()
]
);
$_[KERNEL]->post('COMPONENT', 'output', $message);
$_[KERNEL]->delay_set('MyMessageSendEvent', int(rand(6)));
},
}
);
POE::Kernel->run();
exit 0;
POE-Component-Jabber-3.00/examples/J2Component 0000444 0001750 0001750 00000016155 11161375731 021276 0 ustar nicholas nicholas #!/usr/bin/perl
###############################################################################
#
# J20Component Example
# (c) Nicholas Perez 2006 - 2009.
# Licensed under GPLv2
#
# Please see the included
# LICENSE file for details
#
# This example component script, instantiates a single PCJ object, connects to
# a remote server, sends presence, and then begins sending messages to itself
# on a small random interval
#
###############################################################################
use warnings;
use strict;
use 5.010;
use POE; #include POE constants
use POE::Component::Jabber; #include PCJ
use POE::Filter::XML::Node; #include to build nodes
use POE::Filter::XML::NS(':JABBER');
use Carp;
# First we create our own session within POE to interact with PCJ
POE::Session->create(
options => { debug => 1, trace => 1},
inline_states => {
_start =>
sub
{
my ($kernel, $heap) = @_[KERNEL, HEAP];
$kernel->alias_set('Tester');
# Our PCJ instance is a fullblown object we should store
# so we can access various bits of data during use
$heap->{'component'} =
POE::Component::Jabber->new(
IP => 'localhost',
Port => '5347',
Hostname => 'localhost',
Username => 'jabberd',
Password => 'secret',
Alias => 'COMPONENT',
# The BindDomain argument is used for negotiating connection
# binding on the jabberd2.0 backbone. Essentially this is the
# JID of the component. If this option isn't specified, then
# the Username and Hostname are combined to create a JID
BindDomain => 'MyService.localhost',
# The BindOption argument is for providing extra arguments to
# the connection binding. 'log' will tell the server to send
# every single packet to the component (ie. for a logging
# service). 'default' will tell the server to set the component
# as the default route for packets delivered to unfound
# addresses.
#
# See http://jabberd.jabberstudio.org/dev/docs/component.shtml
# for more information
#BindOption => 'log',
# Shown below are the various connection types included
# from POE::Component::Jabber:
# LEGACY is for pre-XMPP/Jabber connections
# XMPP is for XMPP1.0 compliant connections
# JABBERD14_COMPONENT is for connecting as a service on the
# backbone of a jabberd1.4.x server
# JABBERD20_COMPONENT is for connecting as a service on the
# backbone of a jabberd2.0.x server
#ConnectionType => +LEGACY,
#ConnectionType => +XMPP,
#ConnectionType => +JABBERD14_COMPONENT,
ConnectionType => +JABBERD20_COMPONENT,
Debug => '1',
);
# POE::Component::Jabber now uses POE::Component::PubSub to
# manage event reporting including incoming packets. So in order
# to get anything out of POE::Component::Jabber we need to
# subscribe to the various events of which we have interest.
# You can see a whole list of potential events (including
# possible error states, but seeing the
# POE::Component::Jabber::Events documentation.
# PCJ_READY: Let's us know the connection is up and all of the
# various layers of the protocol have been established.
$kernel->post('COMPONENT', 'subscribe', +PCJ_READY, 'MyReadyEvent');
# PCJ_NODERECEIVED: Fires everytime we get a node down the pipe
$kernel->post('COMPONENT', 'subscribe', +PCJ_NODERECEIVED, 'MyReceivedEvent');
# We could subscribe to all of the various error conditions or
# even all of the various steps along the way so we could
# report the status of the connection as it is building. But
# for simplicity sake, this example will only cover the bare
# minimum to get a connection up and running.
# At this point, we have subscribed to the events we want and
# are ready to tell the component to connect to the server
$kernel->post('COMPONENT', 'connect');
},
_stop =>
sub
{
$_[KERNEL]->alias_remove('Tester');
},
# This is the event with used to subscribe to the PCJ_READY event.
# It will fire anytime a connection is fully initialized and ready for
# use. It passes no arguments.
MyReadyEvent =>
sub
{
say '--- Connection is ready for use! ---';
# Now will we will send presence
my $presence = POE::Filter::XML::Node->new('presence');
# The stored POE::Component::Jabber object has a number of
# useful methods we can use outside of POE event posting,
# including jid()
$presence->setAttribute('from', $_[HEAP]->{'component'}->jid());
# Some of the event names have changed since the 2.x series.
# 'output_handler' was replaced by plain old 'output'
$_[KERNEL]->post('COMPONENT', 'output', $presence);
# Now let's send ourselves some messages
$_[KERNEL]->yield('MyMessageSendEvent');
},
# This is our event with which we subscribed to the PCJ_NODERECEIVED
# event. Once the connection is up and running, our event will be
# called once for every node received. ARG0 will contain the node
MyReceivedEvent =>
sub
{
say '--- Node received! ---';
say $_[ARG0]->toString();
say '----------------------';
},
# This is the event we call from our ready event to start send messages
# to us.
MyMessageSendEvent =>
sub
{
# To route XML across the backbone, an envelope must be provided.
# See http://jabberd.jabberstudio.org/dev/docs/component.shtml for more
# information.
my $envelope = POE::Filter::XML::Node->new
(
'route',
[
'xmlns', +NS_JABBER_COMPONENT,
'from', $_[HEAP]->{'component'}->jid(),
'to', $_[HEAP]->{'component'}->jid()
]
);
my $node = POE::Filter::XML::Node->new('message');
$node->setAttribute('to', $_[HEAP]->{'component'}->jid());
$node->appendTextChild('body', 'This is a test sent at: ' . time());
$envelope->appendChild($node);
$_[KERNEL]->post('COMPONENT', 'output', $envelope);
$_[KERNEL]->delay_set('MyMessageSendEvent', int(rand(6)));
},
}
);
POE::Kernel->run();
exit 0;
POE-Component-Jabber-3.00/examples/J14Component 0000444 0001750 0001750 00000013400 11161375731 021347 0 ustar nicholas nicholas #!/usr/bin/perl
###############################################################################
#
# J14Component Example
# (c) Nicholas Perez 2006 - 2009.
# Licensed under GPLv2
#
# Please see the included
# LICENSE file for details
#
# This example component script, instantiates a single PCJ object, connects to
# a remote server, sends presence, and then begins sending messages to itself
# on a small random interval
#
###############################################################################
use warnings;
use strict;
use 5.010;
use POE; #include POE constants
use POE::Component::Jabber; #include PCJ
use POE::Filter::XML::Node; #include to build nodes
use Carp;
# First we create our own session within POE to interact with PCJ
POE::Session->create(
options => { debug => 1, trace => 1},
inline_states => {
_start =>
sub
{
my ($kernel, $heap) = @_[KERNEL, HEAP];
$kernel->alias_set('Tester');
# Our PCJ instance is a fullblown object we should store
# so we can access various bits of data during use
$heap->{'component'} =
POE::Component::Jabber->new(
IP => 'localhost',
Port => '5348',
Hostname => 'component.localhost',
Username => 'jabberd',
Password => 'secret',
Alias => 'COMPONENT',
# Shown below are the various connection types included
# from POE::Component::Jabber:
# LEGACY is for pre-XMPP/Jabber connections
# XMPP is for XMPP1.0 compliant connections
# JABBERD14_COMPONENT is for connecting as a service on the
# backbone of a jabberd1.4.x server
# JABBERD20_COMPONENT is for connecting as a service on the
# backbone of a jabberd2.0.x server
#ConnectionType => +LEGACY,
#ConnectionType => +XMPP,
ConnectionType => +JABBERD14_COMPONENT,
#ConnectionType => +JABBERD20_COMPONENT,
Debug => '1',
);
# POE::Component::Jabber now uses POE::Component::PubSub to
# manage event reporting including incoming packets. So in order
# to get anything out of POE::Component::Jabber we need to
# subscribe to the various events of which we have interest.
# You can see a whole list of potential events (including
# possible error states, but seeing the
# POE::Component::Jabber::Events documentation.
# PCJ_READY: Let's us know the connection is up and all of the
# various layers of the protocol have been established.
$kernel->post('COMPONENT', 'subscribe', +PCJ_READY, 'MyReadyEvent');
# PCJ_NODERECEIVED: Fires everytime we get a node down the pipe
$kernel->post('COMPONENT', 'subscribe', +PCJ_NODERECEIVED, 'MyReceivedEvent');
# We could subscribe to all of the various error conditions or
# even all of the various steps along the way so we could
# report the status of the connection as it is building. But
# for simplicity sake, this example will only cover the bare
# minimum to get a connection up and running.
# At this point, we have subscribed to the events we want and
# are ready to tell the component to connect to the server
$kernel->post('COMPONENT', 'connect');
},
_stop =>
sub
{
$_[KERNEL]->alias_remove('Tester');
},
# This is the event with used to subscribe to the PCJ_READY event.
# It will fire anytime a connection is fully initialized and ready for
# use. It passes no arguments.
MyReadyEvent =>
sub
{
say '--- Connection is ready for use! ---';
# Now will we will send presence
my $presence = POE::Filter::XML::Node->new('presence');
# The stored POE::Component::Jabber object has a number of
# useful methods we can use outside of POE event posting,
# including jid()
$presence->setAttribute('from', $_[HEAP]->{'component'}->jid());
# Some of the event names have changed since the 2.x series.
# 'output_handler' was replaced by plain old 'output'
$_[KERNEL]->post('COMPONENT', 'output', $presence);
# Now let's send ourselves some messages
$_[KERNEL]->yield('MyMessageSendEvent');
},
# This is our event with which we subscribed to the PCJ_NODERECEIVED
# event. Once the connection is up and running, our event will be
# called once for every node received. ARG0 will contain the node
MyReceivedEvent =>
sub
{
say '--- Node received! ---';
say $_[ARG0]->toString();
say '----------------------';
},
# This is the event we call from our ready event to start send messages
# to us.
MyMessageSendEvent =>
sub
{
my $message = POE::Filter::XML::Node->new
(
'message',
[
'from', $_[HEAP]->{'component'}->jid(),
'to', $_[HEAP]->{'component'}->jid()
]
);
$_[KERNEL]->post('COMPONENT', 'output', $message);
$_[KERNEL]->delay_set('MyMessageSendEvent', int(rand(6)));
},
}
);
POE::Kernel->run();
exit 0;
POE-Component-Jabber-3.00/ChangeLog 0000444 0001750 0001750 00000003104 11161375731 017137 0 ustar nicholas nicholas 2009-03-22 nperez
* Major revision: 3.00
* NOT BACKWARD COMPATIBLE WITH PREVIOUS 2.X BRANCH
* Use new 5.10.0 constructs and features
* New publish/subscribe interface for status events and more
* Based on new POE::Filter::XML 0.35 which is now based on XML::LibXML
* Revert to dependency on POE::Component::SSLify
* Drop Filter::Template dependency
* All constants are now exported through POE::Component::Jabber
* New XPATH based filtering (due to XML::LibXML usage)
2008-07-26 nperez
* Maint revision: 2.03
* Package and distribute SSL code to avoid dep explosion
2007-08-20 nperez
* Maint revision: 2.02
* Fix alias_remove call on _stop (Thanks to Mark Morgan)
2007-01-26 nperez
* Maint revision: 2.01
* Automated tests are still very new to me. Fix problems with defaults.
* Update all module version numbers to stay in sync
2007-01-20 nperez
* Major revision: 2.0
* Reorganized guts into object_states and extensible Protocol specifics
* Full documentation for all included modules
* Examples reworked with documentation inline
* Automated testing written to cover all Protocol dialects
2006-04-30 nperez
* Bumped version to: 1.21
* New handlers for failed connections
* New export in PCJ::Error
* Update dependancies
* Updated installer to Module::Build
* Stem off bitrot
2005-12-04 nperez
* Removed kludged TLS support.
* Updated PCJ Error to include SSL failures
* New dependency: POE::Component::SSLify
* Bumped version to: 1.12
POE-Component-Jabber-3.00/MANIFEST 0000444 0001750 0001750 00000000772 11161375731 016526 0 ustar nicholas nicholas Build.PL
ChangeLog
examples/J14Component
examples/J2Component
examples/LegacyClient
examples/XMPPClient
lib/POE/Component/Jabber.pm
lib/POE/Component/Jabber/Events.pm
lib/POE/Component/Jabber/J14.pm
lib/POE/Component/Jabber/J2.pm
lib/POE/Component/Jabber/Legacy.pm
lib/POE/Component/Jabber/Protocol.pm
lib/POE/Component/Jabber/ProtocolFactory.pm
lib/POE/Component/Jabber/XMPP.pm
LICENSE
Makefile.PL
MANIFEST This list of files
META.yml
README
t/01_basic.t
t/02_xmpp.t
t/03_legacy.t
t/04_j14.t
t/05_j20.t