AnyEvent::XMPP::Ext::Ping - Implementation of XMPP Ping XEP-0199

AnyEvent-XMPP documentation Contained in the AnyEvent-XMPP distribution.

Index

Code Index:

NAME

Top

AnyEvent::XMPP::Ext::Ping - Implementation of XMPP Ping XEP-0199

SYNOPSIS

Top

   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
   });

DESCRIPTION

Top

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 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 Time::HiRes.

METHODS

Top

new (%args)

Creates a new ping handle.

auto_timeout ($timeout)

This method enables automatic connection timeout of new connections. It calls enable_timeout (see below) for every new connection that was connected and emitted a stream_ready event.

This is useful if you want connections that have this extension automatically timeouted. In particular this is useful with modules like AnyEvent::XMPP::Client (see also SYNOPSIS above).

enable_timeout ($con, $timeout)

This enables a periodical ping on the connection $con. $timeout must be the seconds that the ping intervals last.

If the server which is connected via $con didn't respond within $timeout seconds the connection $con will be disconnected.

Please note that there already is a basic timeout mechanism for dead TCP connections in AnyEvent::XMPP::Connection, see also the whitespace_ping_interval configuration variable for a connection there. It then will depend on TCP timeouts to disconnect the connection.

Use enable_timeout and auto_timeout only if you really feel like you need an explicit timeout for your connections.

ping ($con, $dest, $cb, $timeout)

This method sends a ping request to $dest via the AnyEvent::XMPP::Connection in $con. If $dest is undefined the ping will be sent to the connected server. $cb will be called when either the ping timeouts, an error occurs or the ping result was received. $timeout is an optional timeout for the ping request, if $timeout is not given the default IQ timeout for the connection is the relevant timeout.

The first argument to $cb will be the seconds of the round trip time for that request (If you have Time::HiRes). If you don't have Time::HiRes installed the first argument will be undef.

The second argument to $cb will be either undef if no error occured or a AnyEvent::XMPP::Error::IQ error object.

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.

AUTHOR

Top

Robin Redeker, <elmex at ta-sa.org>, JID: <elmex at jabber.org>

COPYRIGHT & LICENSE

Top

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.

AnyEvent-XMPP documentation Contained in the AnyEvent-XMPP distribution. 
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/;


sub new {
   my $this = shift;
   my $class = ref($this) || $this;
   my $self = bless { @_ }, $class;
   $self->init;
   $self
}


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);
         }
      );
}


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;
}


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) : ()),
   );
}


sub ignore_pings {
   my ($self, $enable) = @_;
   $self->{ignore_pings} = $enable;
}


1;