view release on metacpan or  search on metacpan

lib/AnyEvent/XMPP/Connection.pm  view on Meta::CPAN

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

=cut

sub new {
   my $this = shift;
   my $class = ref($this) || $this;
   my $self =
      $class->SUPER::new (
         language         => 'en',
         stream_namespace => 'client',
         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 {

lib/AnyEvent/XMPP/Connection.pm  view on Meta::CPAN

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