AnyEvent-XMPP
view release on metacpan or search on metacpan
lib/AnyEvent/XMPP/Connection.pm view on Meta::CPAN
Note: You have to take care that the stringprep profile for
nodes can be applied at: C<$username>. Otherwise the server
might signal an error. See L<AnyEvent::XMPP::Util> for utility functions
to check this.
B<NOTE:> This field has no effect if C<jid> is given!
=item domain => $domain
If you didn't provide a C<jid> (see above) you have to set the
C<username> which you want to connect as (see above) and the
C<$domain> to connect to.
B<NOTE:> This field has no effect if C<jid> is given!
=item resource => $resource
If this argument is given C<$resource> will be passed as desired
resource on resource binding.
Note: You have to take care that the stringprep profile for
resources can be applied at: C<$resource>. Otherwise the server
might signal an error. See L<AnyEvent::XMPP::Util> for utility functions
to check this.
=item host => $host
This parameter specifies the hostname where we are going
to connect to. The default for this is the C<domain> of the C<jid>.
B<NOTE:> To disable DNS SRV lookup you need to specify the port B<number>
yourself. See C<port> below.
=item use_host_as_sasl_hostname => $bool
This is a special parameter for people who might want to use GSSAPI SASL
mechanism. It will cause the value of the C<host> parameter (see above) to be
passed to the SASL mechanisms, instead of the C<domain> of the JID.
This flag is provided until support for XEP 0233 is deployed, which
will fix the hostname issue w.r.t. GSSAPI SASL.
=item port => $port
This is optional, the default value for C<$port> is 'xmpp-client=5222', which
will used as C<$service> argument to C<tcp_connect> of L<AnyEvent::Socket>.
B<NOTE:> If you specify the port number here (instead of 'xmpp-client=5222'),
B<no> DNS SRV lookup will be done when connecting.
=item connect_timeout => $timeout
This sets the connection timeout. If the socket connect takes too long
a C<disconnect> event will be generated with an appropriate error message.
If this argument is not given no timeout is installed for the connects.
=item password => $password
This is the password for the C<username> above.
=item disable_ssl => $bool
If C<$bool> is true no SSL will be used.
=item old_style_ssl => $bool
If C<$bool> is true the TLS handshake will be initiated when the TCP
connection was established. This is useful if you have to connect to
an old Jabber server, with old-style SSL connections on port 5223.
But that practice has been discouraged in XMPP, and a TLS handshake is done
after the XML stream has been established. Only use this option if you know
what you are doing.
=item disable_sasl => $bool
If C<$bool> is true SASL will NOT be used to authenticate with the server, even
if it advertises SASL through stream features. Alternative authentication
methods will be used, such as IQ Auth (XEP-0078) if the server offers it.
=item disable_iq_auth => $bool
This disables the use of IQ Auth (XEP-0078) for authentication, you might want
to exclude it because it's deprecated and insecure. (However, I want to reach a
maximum in compatibility with L<AnyEvent::XMPP> so I'm not disabling this by
default.
See also C<disable_old_jabber_authentication> below.
=item anal_iq_auth => $bool
This enables the anal iq auth mechanism that will first look in the stream
features before trying to start iq authentication. Yes, servers don't always
advertise what they can. I only implemented this option for my test suite.
=item disable_old_jabber_authentication => $bool
If C<$bool> is a true value, then the B<VERY> old style authentication method
with B<VERY> old jabber server won't be used when a <stream> start tag from the server
without version attribute is received.
The B<VERY> old style authentication method is per default enabled to ensure
maximum compatibility with old jabber implementations. The old method works as
follows: When a <stream> start tag is received from the server with no
'version' attribute IQ Auth (XEP-0078) will be initiated to authenticate with
the server.
Please note that the old authentication method will fail if C<disable_iq_auth>
is true.
=item stream_version_override => $version
B<NOTE:> Only use if you B<really> know what you are doing!
This will override the stream version which is sent in the XMPP stream
initiation element. This is currently only used by the tests which
set C<$version> to '0.9' for testing IQ authentication with ejabberd.
=item whitespace_ping_interval => $interval
This will set the whitespace ping interval (in seconds). The default interval
are 60 seconds. You can disable the whitespace ping by setting C<$interval> to
0.
=back
lib/AnyEvent/XMPP/Connection.pm view on Meta::CPAN
whitespace_ping_interval => 60,
@_
);
$self->{parser} = new AnyEvent::XMPP::Parser;
$self->{writer} = AnyEvent::XMPP::Writer->new (
write_cb => sub { $self->write_data ($_[0]) },
send_iq_cb => sub { my @cb; $self->event (send_iq_hook => (@_, \@cb)); return @cb },
send_msg_cb => sub { my @cb; $self->event (send_message_hook => (@_, \@cb)); return @cb },
send_pres_cb => sub { my @cb; $self->event (send_presence_hook => (@_, \@cb)); return @cb },
);
$self->{parser}->set_stanza_cb (sub {
eval {
$self->handle_stanza (@_);
};
if ($@) {
$self->event (error =>
AnyEvent::XMPP::Error::Exception->new (
exception => $@, context => 'stanza handling'
)
);
}
});
$self->{parser}->set_error_cb (sub {
my ($ex, $data, $type) = @_;
if ($type eq 'xml') {
my $pe = AnyEvent::XMPP::Error::Parser->new (exception => $_[0], data => $_[1]);
$self->event (xml_parser_error => $pe);
$self->disconnect ("xml error: $_[0], $_[1]");
} else {
my $pe = AnyEvent::XMPP::Error->new (
text => "uncaught exception in stanza handling: $ex"
);
$self->event (uncaught_exception_error => $pe);
$self->disconnect ($pe->string);
}
});
$self->{parser}->set_stream_cb (sub {
$self->{stream_id} = $_[0]->attr ('id');
# This is some very bad "hack" for _very_ old jabber
# servers to work with AnyEvent::XMPP
if (not defined $_[0]->attr ('version')) {
$self->start_old_style_authentication
if (not $self->{disable_iq_auth})
&& (not $self->{disable_old_jabber_authentication})
}
});
$self->{iq_id} = 1;
$self->{default_iq_timeout} = 60;
$self->{disconnect_cb} = sub {
my ($host, $port, $message) = @_;
delete $self->{authenticated};
delete $self->{ssl_enabled};
$self->event (disconnect => $host, $port, $message);
$self->{disconnect_cb} = sub {};
delete $self->{writer};
$self->{parser}->cleanup;
delete $self->{parser};
};
if ($self->{jid}) {
my ($user, $host, $res) = split_jid ($self->{jid});
$self->{username} = $user;
$self->{domain} = $host;
$self->{resource} = $res if defined $res;
}
$self->{host} = $self->{domain} unless defined $self->{host};
$self->{port} = 'xmpp-client=5222' unless defined $self->{port};
my $proxy_cb = sub {
my ($self, $er) = @_;
$self->event (error => $er);
};
$self->reg_cb (
xml_parser_error => $proxy_cb,
sasl_error => $proxy_cb,
stream_error => $proxy_cb,
bind_error => $proxy_cb,
iq_auth_error => $proxy_cb,
iq_result_cb_exception => sub {
my ($self, $ex) = @_;
$self->event (error =>
AnyEvent::XMPP::Error::Exception->new (
exception => $ex, context => 'iq result callback execution'
)
);
},
tls_error => sub {
my ($self) = @_;
$self->event (error =>
AnyEvent::XMPP::Error->new (text => 'tls_error: tls negotiation failed')
);
},
iq_xml => sub { shift @_; $self->handle_iq (@_) }
);
if ($self->{whitespace_ping_interval} > 0) {
$self->reg_cb (
stream_ready => sub {
my ($self) = @_;
$self->_start_whitespace_ping;
$self->unreg_me;
},
disconnect => sub {
$self->_stop_whitespace_ping;
$self->unreg_me;
}
);
}
$self->set_exception_cb (sub {
my ($ex) = @_;
$self->event (error =>
AnyEvent::XMPP::Error::Exception->new (
exception => $ex, context => 'event callback'
)
);
});
return $self;
}
=item B<connect ()>
Try to connect (non blocking) to the domain and port passed in C<new>.
The connection is performed non blocking, so this method will just
trigger the connection process. The event C<connect> will be emitted
when the connection was successfully established.
If the connection try was not successful a C<disconnect> event
will be generated with an error message.
NOTE: Please note that you can't reconnect a L<AnyEvent::XMPP::Connection>
object. You need to recreate it if you want to reconnect.
NOTE: The "XML" stream initiation is sent when the connection
was successfully connected.
=cut
sub connect {
my ($self) = @_;
$self->SUPER::connect ($self->{host}, $self->{port}, $self->{connect_timeout});
}
sub connected {
my ($self) = @_;
if ($self->{old_style_ssl}) {
$self->enable_ssl;
}
$self->init;
$self->event (connect => $self->{peer_host}, $self->{peer_port});
}
sub send_buffer_empty {
my ($self) = @_;
$self->event ('send_buffer_empty');
}
sub handle_data {
my ($self, $buf) = @_;
$self->event (debug_recv => $$buf);
$self->{parser}->feed (substr $$buf, 0, (length $$buf), '');
}
sub debug_wrote_data {
my ($self, $data) = @_;
$self->event (debug_send => $data);
}
sub write_data {
my ($self, $data) = @_;
$self->event (send_stanza_data => $data);
$self->SUPER::write_data ($data);
}
sub default_namespace {
return 'client';
}
sub handle_stanza {
my ($self, $p, $node) = @_;
if (not defined $node) { # got stream end
$self->disconnect ("end of 'XML' stream encountered");
return;
}
my $stop = 0;
$self->event (recv_stanza_xml => $node, \$stop);
$stop and return;
my $def_ns = $self->default_namespace;
if ($node->eq (stream => 'features')) {
$self->event (stream_features => $node);
$self->{features} = $node;
$self->handle_stream_features ($node);
} elsif ($node->eq (tls => 'proceed')) {
$self->enable_ssl;
$self->{parser}->init;
$self->{writer}->init;
$self->{writer}->send_init_stream (
$self->{language}, $self->{domain}, $self->{stream_namespace}
);
} elsif ($node->eq (tls => 'failure')) {
$self->event ('tls_error');
$self->disconnect ('TLS failure on TLS negotiation.');
} elsif ($node->eq (sasl => 'challenge')) {
$self->handle_sasl_challenge ($node);
} elsif ($node->eq (sasl => 'success')) {
$self->handle_sasl_success ($node);
} elsif ($node->eq (sasl => 'failure')) {
my $error = AnyEvent::XMPP::Error::SASL->new (node => $node);
$self->event (sasl_error => $error);
$self->disconnect ('SASL authentication failure: ' . $error->string);
} elsif ($node->eq ($def_ns => 'iq')) {
$self->event (iq_xml => $node);
} elsif ($node->eq ($def_ns => 'message')) {
$self->event (message_xml => $node);
} elsif ($node->eq ($def_ns => 'presence')) {
$self->event (presence_xml => $node);
} elsif ($node->eq (stream => 'error')) {
$self->handle_error ($node);
}
}
# This method is private
sub init {
my ($self) = @_;
$self->{writer}->send_init_stream ($self->{language}, $self->{domain}, $self->{stream_namespace}, $self->{stream_version_override});
}
=item B<is_connected ()>
Returns true if the connection is still connected and stanzas can be
sent.
=cut
sub is_connected {
my ($self) = @_;
$self->{authenticated}
}
=item B<set_default_iq_timeout ($seconds)>
This sets the default timeout for IQ requests. If the timeout runs out
the request will be aborted and the callback called with a L<AnyEvent::XMPP::Error::IQ> object
where the C<condition> method returns a special value (see also C<condition> method of L<AnyEvent::XMPP::Error::IQ>).
lib/AnyEvent/XMPP/Connection.pm view on Meta::CPAN
my $type = $node->attr ('type');
my $id = $node->attr ('id');
delete $self->{iq_timers}->{$id} if defined $id;
if ($type eq 'result') {
if (my $cb = delete $self->{iqs}->{$id}) {
eval {
$cb->($node);
};
if ($@) { $self->event (iq_result_cb_exception => $@) }
}
} elsif ($type eq 'error') {
if (my $cb = delete $self->{iqs}->{$id}) {
my $error = AnyEvent::XMPP::Error::IQ->new (node => $node);
eval {
$cb->(($error->type eq 'continue' ? $node : undef), $error);
};
if ($@) { $self->event (iq_result_cb_exception => $@) }
}
} else {
my $handled = 0;
$self->event ("iq_${type}_request_xml" => $node, \$handled);
$handled or $self->reply_iq_error ($node, undef, 'service-unavailable');
}
}
sub send_sasl_auth {
my ($self, @mechs) = @_;
for (qw/username password domain/) {
die "No '$_' argument given to new, but '$_' is required\n"
unless defined $self->{$_};
}
$self->{writer}->send_sasl_auth (
[map { $_->text } @mechs],
$self->{username},
($self->{use_host_as_sasl_hostname}
? $self->{host}
: $self->{domain}),
$self->{password}
);
}
sub handle_stream_features {
my ($self, $node) = @_;
my @bind = $node->find_all ([qw/bind bind/]);
my @tls = $node->find_all ([qw/tls starttls/]);
# and yet another weird thingie: in XEP-0077 it's said that
# the register feature MAY be advertised by the server. That means:
# it MAY not be advertised even if it is available... so we don't
# care about it...
# my @reg = $node->find_all ([qw/register register/]);
if (not ($self->{disable_ssl}) && not ($self->{ssl_enabled}) && @tls) {
$self->{writer}->send_starttls;
} elsif (not $self->{authenticated}) {
my $continue = 1;
$self->event (stream_pre_authentication => \$continue);
if ($continue) {
$self->authenticate;
}
} elsif (@bind) {
$self->do_rebind ($self->{resource});
}
}
=item B<authenticate>
This method should be called after the C<stream_pre_authentication> event
was emitted to continue authentication of the stream.
Usually this method only has to be called when you want to register before
you authenticate. See also the documentation of the C<stream_pre_authentication>
event below.
=cut
sub authenticate {
my ($self) = @_;
my $node = $self->{features};
my @mechs = $node->find_all ([qw/sasl mechanisms/], [qw/sasl mechanism/]);
# Yes, and also iq-auth isn't correctly advertised in the
# stream features! We all love the depreacted XEP-0078, eh?
my @iqa = $node->find_all ([qw/iqauth auth/]);
if (not ($self->{disable_sasl}) && @mechs) {
$self->send_sasl_auth (@mechs)
} elsif (not $self->{disable_iq_auth}) {
if ($self->{anal_iq_auth} && !@iqa) {
if (@iqa) {
$self->do_iq_auth;
} else {
die "No authentication method left after anal iq auth, neither SASL or IQ auth.\n";
}
} else {
$self->do_iq_auth;
}
} else {
die "No authentication method left, neither SASL or IQ auth.\n";
}
}
sub handle_sasl_challenge {
my ($self, $node) = @_;
$self->{writer}->send_sasl_response ($node->text);
}
sub handle_sasl_success {
my ($self, $node) = @_;
( run in 1.684 second using v1.01-cache-2.11-cpan-acf6aa7dc9e )