AnyEvent-XMPP
view release on metacpan or search on metacpan
lib/AnyEvent/XMPP/Connection.pm view on Meta::CPAN
domain => "jabber.org",
resource => "AnyEvent::XMPP"
);
$con->reg_cb (stream_ready => sub { print "XMPP stream ready!\n" });
$con->connect; # will do non-blocking connect
=head1 DESCRIPTION
This module represents a XMPP stream as described in RFC 3920. You can issue the basic
XMPP XML stanzas with methods like C<send_iq>, C<send_message> and C<send_presence>.
And receive events with the C<reg_cb> event framework from the connection.
If you need instant messaging stuff please take a look at C<AnyEvent::XMPP::IM::Connection>.
=head1 METHODS
=over 4
=item B<new (%args)>
Following arguments can be passed in C<%args>:
=over 4
=item language => $tag
This should be the language of the human readable contents that
will be transmitted over the stream. The default will be 'en'.
Please look in RFC 3066 how C<$tag> should look like.
=item jid => $jid
This can be used to set the settings C<username>, C<domain>
(and optionally C<resource>) from a C<$jid>.
=item username => $username
This is your C<$username> (the userpart in the JID);
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.
lib/AnyEvent/XMPP/Connection.pm view on Meta::CPAN
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.
lib/AnyEvent/XMPP/Connection.pm view on Meta::CPAN
(defined $iqnode->attr ('from') ? (to => $iqnode->attr ('from')) : ()),
(defined $iqnode->attr ('to') ? (from => $iqnode->attr ('to')) : ()),
%attrs
);
}
sub handle_iq {
my ($self, $node) = @_;
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) = @_;
$self->{authenticated} = 1;
$self->{parser}->init;
$self->{writer}->init;
$self->{writer}->send_init_stream (
$self->{language}, $self->{domain}, $self->{stream_namespace}
);
}
sub handle_error {
my ($self, $node) = @_;
my $error = AnyEvent::XMPP::Error::Stream->new (node => $node);
lib/AnyEvent/XMPP/Connection.pm view on Meta::CPAN
if ($do_resource && defined $self->{resource}) {
$fields->{resource} = $self->{resource}
}
$self->send_iq (set => {
defns => 'auth',
node => { ns => 'auth', name => 'query', childs => [
map { { name => $_, childs => [ $fields->{$_} ] } } reverse sort keys %$fields
]}
}, sub {
my ($n, $e) = @_;
if ($e) {
$self->event (iq_auth_error =>
AnyEvent::XMPP::Error::IQAuth->new (context => 'iq_error', iq_error => $e)
);
} else {
$self->{authenticated} = 1;
$self->{jid} = join_jid ($self->{username}, $self->{domain}, $self->{resource});
$self->event (stream_ready => $self->{jid});
}
});
}
=item B<send_presence ($type, $create_cb, %attrs)>
This method sends a presence stanza, for the meanings
of C<$type>, C<$create_cb> and C<%attrs> please take a look
at the documentation for C<send_presence> method of L<AnyEvent::XMPP::Writer>.
This methods does attach an id attribute to the presence stanza and
will return the id that was used (so you can react on possible replies).
=cut
sub send_presence {
my ($self, $type, $create_cb, %attrs) = @_;
my $id = $self->{iq_id}++;
$self->{writer}->send_presence ($id, $type, $create_cb, %attrs);
$id
}
=item B<send_message ($to, $type, $create_cb, %attrs)>
This method sends a message stanza, for the meanings
of C<$to>, C<$type>, C<$create_cb> and C<%attrs> please take a look
at the documentation for C<send_message> method of L<AnyEvent::XMPP::Writer>.
This methods does attach an id attribute to the message stanza and
will return the id that was used (so you can react on possible replies).
=cut
sub send_message {
my ($self, $to, $type, $create_cb, %attrs) = @_;
my $id = delete $attrs{id} || $self->{iq_id}++;
$self->{writer}->send_message ($id, $to, $type, $create_cb, %attrs);
$id
}
=item B<do_rebind ($resource)>
In case you got a C<bind_error> event and want to retry
binding you can call this function to set a new C<$resource>
and retry binding.
If it fails again you can call this again. Becareful not to
end up in a loop!
If binding was successful the C<stream_ready> event will be generated.
=cut
sub do_rebind {
my ($self, $resource) = @_;
$self->{resource} = $resource;
$self->send_iq (
set =>
sub {
my ($w) = @_;
if ($self->{resource}) {
simxml ($w,
defns => 'bind',
node => {
name => 'bind',
childs => [ { name => 'resource', childs => [ $self->{resource} ] } ]
}
)
} else {
simxml ($w, defns => 'bind', node => { name => 'bind' })
}
},
sub {
my ($ret_iq, $error) = @_;
if ($error) {
# TODO: make bind error into a seperate error class?
if ($error->xml_node ()) {
my ($res) = $error->xml_node ()->find_all ([qw/bind bind/], [qw/bind resource/]);
$self->event (bind_error => $error, ($res ? $res : $self->{resource}));
} else {
$self->event (bind_error => $error);
}
} else {
my @jid = $ret_iq->find_all ([qw/bind bind/], [qw/bind jid/]);
my $jid = $jid[0]->text;
unless ($jid) { die "Got empty JID tag from server!\n" }
$self->{jid} = $jid;
$self->event (stream_ready => $jid);
}
}
);
}
sub _start_whitespace_ping {
my ($self) = @_;
return unless $self->{whitespace_ping_interval} > 0;
$self->{_ws_ping} =
AnyEvent->timer (after => $self->{whitespace_ping_interval}, cb => sub {
$self->{writer}->send_whitespace_ping;
$self->_start_whitespace_ping;
});
}
sub _stop_whitespace_ping {
delete $_[0]->{_ws_ping};
}
=item B<jid>
After the stream has been bound to a resource the JID can be retrieved via this
method.
=cut
sub jid { $_[0]->{jid} }
=item B<features>
Returns the last received <features> tag in form of an L<AnyEvent::XMPP::Node> object.
=cut
sub features { $_[0]->{features} }
=item B<stream_id>
This is the ID of this stream that was given us by the server.
=cut
sub stream_id { $_[0]->{stream_id} }
=back
=head1 EVENTS
The L<AnyEvent::XMPP::Connection> class is derived from the L<Object::Event> class,
and thus inherits the event callback registering system from it. Consult the
documentation of L<Object::Event> about more details.
lib/AnyEvent/XMPP/Connection.pm view on Meta::CPAN
=over 4
=item stream_features => $node
This event is sent when a stream feature (<features>) tag is received. C<$node> is the
L<AnyEvent::XMPP::Node> object that represents the <features> tag.
=item stream_pre_authentication
This event is emitted after TLS/SSL was initiated (if enabled) and before any
authentication happened.
The return value of the first event callback that is called decides what happens next.
If it is true value the authentication continues. If it is undef or a false value
authentication is stopped and you need to call C<authentication> later.
value
This event is usually used when you want to do in-band registration,
see also L<AnyEvent::XMPP::Ext::Registration>.
=item stream_ready => $jid
This event is sent if the XML stream has been established (and
resources have been bound) and is ready for transmitting regular stanzas.
C<$jid> is the bound jabber id.
=item error => $error
This event is generated whenever some error occured.
C<$error> is an instance of L<AnyEvent::XMPP::Error>.
Trivial error reporting may look like this:
$con->reg_cb (error => sub { warn "xmpp error: " . $_[1]->string . "\n" });
Basically this event is a collect event for all other error events.
=item stream_error => $error
This event is sent if a XML stream error occured. C<$error>
is a L<AnyEvent::XMPP::Error::Stream> object.
=item xml_parser_error => $error
This event is generated whenever the parser trips over XML that it can't
read. C<$error> is a L<AnyEvent::XMPP::Error::Parser> object.
=item tls_error
This event is emitted when a TLS error occured on TLS negotiation.
After this the connection will be disconnected.
=item sasl_error => $error
This event is emitted on SASL authentication error.
=item iq_auth_error => $error
This event is emitted when IQ authentication (XEP-0078) failed.
=item bind_error => $error, $resource
This event is generated when the stream was unable to bind to
any or the in C<new> specified resource. C<$error> is a L<AnyEvent::XMPP::Error::IQ>
object. C<$resource> is the errornous resource string or undef if none
was received.
The C<condition> of the C<$error> might be one of: 'bad-request',
'not-allowed' or 'conflict'.
Node: this is untested, I couldn't get the server to send a bind error
to test this.
=item connect => $host, $port
This event is generated when a successful TCP connect was performed to
the domain passed to C<new>.
Note: C<$host> and C<$port> might be different from the domain you passed to
C<new> if C<connect> performed a SRV RR lookup.
If this connection is lost a C<disconnect> will be generated with the same
C<$host> and C<$port>.
=item disconnect => $host, $port, $message
This event is generated when the TCP connection was lost or another error
occurred while writing or reading from it.
C<$message> is a human readable error message for the failure.
C<$host> and C<$port> were the host and port we were connected to.
Note: C<$host> and C<$port> might be different from the domain you passed to
C<new> if C<connect> performed a SRV RR lookup.
=item recv_stanza_xml => $node, $rstop
This event is generated before any processing of a "XML" stanza happens.
C<$node> is the node of the stanza that is being processed, it's of
type L<AnyEvent::XMPP::Node>.
This method might not be as handy for debugging purposes as C<debug_recv>.
If you want to handle the stanza yourself and don't want this module
to take care of it set a true value to the scalar referenced by C<$rstop>.
=item send_stanza_data => $data
This event is generated shortly before data is sent to the socket.
C<$data> contains a complete "XML" stanza or the end of stream closing
tag. This method is useful for debugging purposes and I recommend
using XML::Twig or something like that to display it nicely.
See also the event C<debug_send>.
=item debug_send => $data
This method is invoked whenever data is written out. This event
is mostly the same as C<send_stanza_data>.
=item debug_recv => $data
This method is invoked whenever a chunk of data was received.
It works to filter C<$data> through L<XML::Twig> for debugging
display purposes sometimes, but as C<$data> is some arbitrary chunk
of bytes you might get a XML parse error (did I already mention that XMPP's
application of "XML" sucks?).
So you might want to use C<recv_stanza_xml> to detect
complete stanzas. Unfortunately C<recv_stanza_xml> doesn't have the
( run in 0.687 second using v1.01-cache-2.11-cpan-2398b32b56e )