package AnyEvent::XMPP::Ext::Ping;
use AnyEvent::XMPP::Namespaces qw/xmpp_ns/;
use AnyEvent::XMPP::Util qw/simxml/;
use AnyEvent::XMPP::Ext;
use strict;
our @ISA = qw/AnyEvent::XMPP::Ext/;
=head1 NAME
AnyEvent::XMPP::Ext::Ping - Implementation of XMPP Ping XEP-0199
=head1 SYNOPSIS
use AnyEvent::XMPP::Ext::Ping;
my $con = AnyEvent::XMPP::IM::Connection->new (...);
$con->add_extension (my $ping = AnyEvent::XMPP::Ext::Ping->new);
# this enables auto-timeout of a connection if it didn't answer
# within 120 seconds to a ping with a reply
$ping->enable_timeout ($con, 120);
my $cl = AnyEvent::XMPP::Client->new (...);
$cl->add_extension (my $ping = AnyEvent::XMPP::Ext::Ping->new);
# this enables auto-timeout of newly created connections
$ping->auto_timeout (120);
$ping->ping ($con, 'ping_dest@server.tld', sub {
my ($time, $error) = @_;
if ($error) {
# we got an error
}
# $time is a float (seconds) of the rtt if you got Time::HiRes
});
=head1 DESCRIPTION
This extension implements XEP-0199: XMPP Ping.
It allows you to define a automatic ping timeouter that will disconnect
dead connections (which didn't reply to a ping after N seconds). See also
the documentation of the C<enable_timeout> method below.
It also allows you to send pings to any XMPP entity you like and
will measure the time it took if you got L<Time::HiRes>.
=head1 METHODS
=over 4
=item B<new (%args)>
Creates a new ping handle.
=cut
sub new {
my $this = shift;
my $class = ref($this) || $this;
my $self = bless { @_ }, $class;
$self->init;
$self
}
=item B<auto_timeout ($timeout)>
This method enables automatic connection timeout of
new connections. It calls C<enable_timeout> (see below)
for every new connection that was connected and emitted
a C<stream_ready> event.
This is useful if you want connections that have this extension
automatically timeouted. In particular this is useful with modules
like L<AnyEvent::XMPP::Client> (see also L<SYNOPSIS> above).
=cut
sub auto_timeout {
my ($self, $timeout) = @_;
$self->{autotimeout} = $timeout;
return if defined $self->{cb_id2};
$self->{cb_id2} =
$self->reg_cb (
stream_ready => sub {
my ($self, $con) = @_;
$self->enable_timeout ($con, \$self->{autotimeout});
},
disconnect => sub {
my ($self, $con) = @_;
$self->disable_timeout ($con);
}
);
}
=item B<enable_timeout ($con, $timeout)>
This enables a periodical ping on the connection C<$con>.
C<$timeout> must be the seconds that the ping intervals last.
If the server which is connected via C<$con> didn't respond within C<$timeout>
seconds the connection C<$con> will be disconnected.
Please note that there already is a basic timeout mechanism
for dead TCP connections in L<AnyEvent::XMPP::Connection>, see also
the C<whitespace_ping_interval> configuration variable for a connection
there. It then will depend on TCP timeouts to disconnect the connection.
Use C<enable_timeout> and C<auto_timeout> only if you really feel
like you need an explicit timeout for your connections.
=cut
sub enable_timeout {
my ($self, $con, $timeout) = @_;
my $rt = $timeout;
unless (ref $timeout) {
$rt = \$timeout;
}
$self->_start_cust_timeout ($con, $rt);
}
sub disable_timeout {
my ($self, $con) = @_;
delete $self->{cust_timeouts}->{$con};
}
sub _start_cust_timeout {
my ($self, $con, $rtimeout) = @_;
return unless $con->is_connected;
$self->{cust_timeouts}->{$con} =
AnyEvent->timer (after => $$rtimeout, cb => sub {
delete $self->{cust_timeouts}->{$con};
return unless $con->is_connected;
$self->ping ($con, undef, sub {
my ($t, $e) = @_;
if (defined ($e) && $e->condition eq 'client-timeout') {
$con->disconnect ("exceeded ping timeout of $$rtimeout seconds");
} else {
$self->_start_cust_timeout ($con, $rtimeout)
}
}, $$rtimeout);
});
}
sub init {
my ($self) = @_;
if (eval "require Time::HiRes") {
$self->{has_time_hires} = 1;
}
$self->{cb_id} = $self->reg_cb (
iq_get_request_xml => sub {
my ($self, $con, $node) = @_;
if ($self->handle_ping ($con, $node)) {
return 1;
}
()
}
);
}
sub disco_feature { xmpp_ns ('ping') }
sub DESTROY {
my ($self) = @_;
$self->unreg_cb ($self->{cb_id});
$self->unreg_cb ($self->{cb_id2}) if defined $self->{cb_id2};
}
sub handle_ping {
my ($self, $con, $node) = @_;
if (my ($q) = $node->find_all ([qw/ping ping/])) {
unless ($self->{ignore_pings}) {
$con->reply_iq_result ($node);
}
return 1;
}
0;
}
=item B<ping ($con, $dest, $cb, $timeout)>
This method sends a ping request to C<$dest> via the L<AnyEvent::XMPP::Connection>
in C<$con>. If C<$dest> is undefined the ping will be sent to the connected
server. C<$cb> will be called when either the ping timeouts, an error occurs
or the ping result was received. C<$timeout> is an optional timeout for the
ping request, if C<$timeout> is not given the default IQ timeout for the
connection is the relevant timeout.
The first argument to C<$cb> will be the seconds of the round trip time for
that request (If you have L<Time::HiRes>). If you don't have L<Time::HiRes>
installed the first argument will be undef.
The second argument to C<$cb> will be either undef if no error occured or
a L<AnyEvent::XMPP::Error::IQ> error object.
=cut
sub ping {
my ($self, $con, $jid, $cb, $timeout) = @_;
my $time = 0;
if ($self->{has_time_hires}) {
$time = [Time::HiRes::gettimeofday ()];
}
$con->send_iq (
get => { defns => ping => node => { name => 'ping' } },
sub {
my ($n, $e) = @_;
my $elap = 0;
if ($self->{has_time_hires}) {
$elap = Time::HiRes::tv_interval ($time, [Time::HiRes::gettimeofday ()]);
}
$cb->($elap, $e);
},
(defined $jid ? (to => $jid) : ()),
(defined $timeout ? (timeout => $timeout) : ()),
);
}
=item B<ignore_pings ($bool)>
This method is mostly for testing, it tells this extension
to ignore all ping requests and will prevent any response from
being sent.
=cut
sub ignore_pings {
my ($self, $enable) = @_;
$self->{ignore_pings} = $enable;
}
=back
=head1 AUTHOR
Robin Redeker, C<< <elmex at ta-sa.org> >>, JID: C<< <elmex at jabber.org> >>
=head1 COPYRIGHT & LICENSE
Copyright 2007, 2008 Robin Redeker, all rights reserved.
This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
=cut
1;