Net/XMPP2/Connection.pm

package Net::XMPP2::Connection;
use strict;
use AnyEvent;
use IO::Socket::INET;
use Net::XMPP2::Parser;
use Net::XMPP2::Writer;
use Net::XMPP2::Util qw/split_jid/;
use Net::XMPP2::Event;
use Net::XMPP2::SimpleConnection;
use Net::XMPP2::Namespaces qw/xmpp_ns/;
use Net::XMPP2::Error;
use Net::DNS;

our @ISA = qw/Net::XMPP2::SimpleConnection Net::XMPP2::Event/;

=head1 NAME

Net::XMPP2::Connection - A XML stream that implements the XMPP RFC 3920.

=head1 SYNOPSIS

   use Net::XMPP2::Connection;

   my $con =
      Net::XMPP2::Connection->new (
         username => "abc",
         domain => "jabber.org",
         resource => "Net::XMPP2"
      );

   $con->connect or die "Couldn't connect to jabber.org: $!";
   $con->init;
   $con->reg_cb (stream_ready => sub { print "XMPP stream ready!\n" });

=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<Net::XMPP2::IM::Connection>.

=head1 METHODS

=head2 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 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<Net::XMPP2::Util> for utility functions
to check this.

=item domain => $domain

This is the destination host we are going to connect to.
As the connection won't be automatically connected use C<connect>
to initiate the connect.

Note: A SRV RR lookup will be performed to discover the real hostname
and port to connect to. See also C<connect>.

=item override_host => $host
=item override_port => $port

This will be used as override to connect to.

=item port => $port

This is optional, the default port is 5222.

Note: A SRV RR lookup will be performed to discover the real hostname
and port to connect to. See also C<connect>.

=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<Net::XMPP2::Util> for utility functions
to check this.

=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.

=back

=cut

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

   $self->{parser} = new Net::XMPP2::Parser;
   $self->{writer} = Net::XMPP2::Writer->new (
      write_cb => sub { $self->write_data ($_[0]) }
   );

   $self->{parser}->set_stanza_cb (sub {
      $self->handle_stanza (@_);
   });

   $self->{iq_id} = 1;

   $self->{disconnect_cb} = sub {
      my ($host, $port, $message) = @_;
      delete $self->{authenticated};
      delete $self->{ssl_enabled};
      $self->event (disconnect => $host, $port, $message);
   };

   if ($self->{jid}) {
      my ($user, $host, $res) = split_jid ($self->{jid});
      $self->{username} = $user;
      $self->{domain}   = $host;
      $self->{resource} = $res if defined $res;
   }

   for (qw/username password domain/) {
      die "No '$_' argument given to new, but '$_' is required\n"
         unless $self->{$_};
   }

   return $self;
}

=head2 connect ($no_srv_rr)

Try to connect to the domain and port passed in C<new>.

A SRV RR lookup will be performed on the domain to discover
the host and port to use. If you don't want this set C<$no_srv_rr>
to a true value. C<$no_srv_rr> is false by default.

As the SRV RR lookup might return multiple host and you fail to
connect to one you might just call this function again to try a
different host.

If C<connect> was successful and we connected a true value is returned.
If the connect was unsuccessful undef is returned and C<$!> will be set
to the error that occured while connecting.

If you want to know whether further connection attempts might be more
successful (as SRV RR lookup may return multiple hosts) call C<may_try_connect>
(see also C<may_try_connect>).

Note that an internal list will be kept of tried hosts.  Use
C<reset_connect_tries> to reset the internal list of tried hosts.

=cut

sub connect {
   my ($self, $no_srv_rr) = @_;

   my ($host, $port) = ($self->{domain}, $self->{port} || 5222);
   if ($self->{override_host}) {
      ($host, $port) = ($self->{override_host}, $self->{override_port} || 5222);

   } else {
      unless ($no_srv_rr) {
         my $res = Net::DNS::Resolver->new;
         my $p   = $res->query ('_xmpp-client._tcp.'.$host, 'SRV');
         if ($p) {
            my @srvs = grep { $_->type eq 'SRV' } $p->answer;
            if (@srvs) {
               @srvs = sort { $a->priority <=> $b->priority } @srvs;
               @srvs = sort { $b->weight <=> $a->weight } @srvs; # TODO
               $port = $srvs[0]->port;
               $host = $srvs[0]->target;
            }
         }
      }
   }

   if ($self->SUPER::connect ($host, $port)) {
      $self->event (connect => $host, $port);
      return 1;
   } else {
      return undef;
   }
}

=head2 may_try_connect

Returns the number of left alternatives of hosts to connect to for the
domain passed to C<new>.

An internal list of tried hosts will be managed by C<connect> and those
hosts will be ignored by a SRV RR lookup (which will be done if you
call this function).

Use C<reset_connect_tries> to reset the internal list of tried hosts.

=cut

sub may_try_connect {
   # TODO
}

=head2 reset_connect_tries

This function resets the internal list of tried hosts for C<connect>.
See also C<connect>.

=cut

sub reset_connect_tries {
   # TODO
}

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->SUPER::write_data ($data);
}

sub handle_stanza {
   my ($self, $p, $node) = @_;

   if ($node->eq (stream => 'features')) {
      $self->event (stream_features => $node);
      $self->handle_stream_features ($node);
      $self->{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});

   } 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 = Net::XMPP2::Error::SASL->new (node => $node);
      $self->event (sasl_error => $error);

   } elsif ($node->eq (client => 'iq')) {
      $self->handle_iq ($node);

   } elsif ($node->eq (client => 'message')) {
      $self->event (message_xml => $node);

   } elsif ($node->eq (client => 'presence')) {
      $self->event (presence_xml => $node);

   } elsif ($node->eq (stream => 'error')) {
      $self->handle_error ($node);

   } else {
      warn "Didn't understood stanza: '" . $node->name . "'";
   }
}

=head2 init ()

Initiate the XML stream.

=cut

sub init {
   my ($self) = @_;
   $self->{writer}->send_init_stream ($self->{language}, $self->{domain});
}

=head2 is_connected ()

Returns true if the connection is still connected and stanzas can be
sent.

=cut

sub is_connected {
   my ($self) = @_;
   $self->{authenticated}
}

=head2 send_iq ($type, $create_cb, $result_cb, %attrs)

This method sends an IQ XMPP request.

Please take a look at the documentation for C<send_iq> in Net::XMPP2::Writer
about the meaning of C<$type>, C<$create_cb> and C<%attrs>.

C<$result_cb> will be called when a result was received. The first argument to
C<$result_cb> will be a Net::XMPP2::Node instance containing the IQ result
stanza contents.

If the IQ resulted in a stanza error the second argument to C<$result_cb> will
be C<undef> (if the error type was not 'continue') and the third argument will
be a L<Net::XMPP2::Error::IQ> object.

This method returns the newly generated id for this iq request.

=cut

sub send_iq {
   my ($self, $type, $create_cb, $result_cb, %attrs) = @_;
   my $id = $self->{iq_id}++;
   $self->{iqs}->{$id} = $result_cb;
   $self->{writer}->send_iq ($id, $type, $create_cb, %attrs);
   $id
}

=head2 reply_iq_result ($req_iq_node, $create_cb, %attrs)

This method will generate a result reply to the iq request C<Net::XMPP2::Node>
in C<$req_iq_node>.

Please take a look at the documentation for C<send_iq> in Net::XMPP2::Writer
about the meaning C<$create_cb> and C<%attrs>.

Use C<$create_cb> to create the XML for the result.

The type for this iq reply is 'result'.

=cut

sub reply_iq_result {
   my ($self, $iqnode, $create_cb, %attrs) = @_;
   $self->{writer}->send_iq ($iqnode->attr ('id'), 'result', $create_cb, %attrs);
}

=head2 reply_iq_error ($req_iq_node, $error_type, $error, %attrs)

This method will generate an error reply to the iq request C<Net::XMPP2::Node>
in C<$req_iq_node>.

C<$error_type> is one of 'cancel', 'continue', 'modify', 'auth' and 'wait'.
C<$error> is one of the defined error conditions described in
L<Net::XMPP2::Writer::write_error_tag>.

Please take a look at the documentation for C<send_iq> in Net::XMPP2::Writer
about the meaning of C<%attrs>.

The type for this iq reply is 'error'.

=cut

sub reply_iq_error {
   my ($self, $iqnode, $errtype, $error, %attrs) = @_;

   $self->{writer}->send_iq (
      $iqnode->attr ('id'), 'error',
      sub { $self->{writer}->write_error_tag ($iqnode, $errtype, $error) },
      %attrs
   );
}

sub handle_iq {
   my ($self, $node) = @_;

   my $type = $node->attr ('type');

   if ($type eq 'result') {
      if (my $cb = delete $self->{iqs}->{$node->attr ('id')}) {
         $cb->($node);
      }

   } elsif ($type eq 'error') {
      if (my $cb = delete $self->{iqs}->{$node->attr ('id')}) {

         my $error = Net::XMPP2::Error::IQ->new (node => $node);
         $cb->(($error->type eq 'continue' ? $node : undef), $error);
      }

   } else {
      my $handled = 0;
      $self->event ("iq_${type}_request_xml" => $node, \$handled);

      my @from;
      push @from, (to => $node->attr ('from')) if $node->attr ('from');

      unless ($handled) {
         $self->reply_iq_error ($node, undef, 'feature-not-implemented', @from);
      }
   }
}

sub handle_stream_features {
   my ($self, $node) = @_;
   my @mechs = $node->find_all ([qw/sasl mechanisms/], [qw/sasl mechanism/]);
   my @bind  = $node->find_all ([qw/bind bind/]);
   my @tls   = $node->find_all ([qw/tls starttls/]);

   if (not ($self->{disable_ssl}) && not ($self->{ssl_enabled}) && @tls) {
      $self->{writer}->send_starttls;

   } elsif (not ($self->{authenticated}) and @mechs) {
      $self->{writer}->send_sasl_auth (
         (join ' ', map { $_->text } @mechs),
         $self->{username}, $self->{domain}, $self->{password}
      );

   } elsif (@bind) {
      $self->do_rebind ($self->{resource});
   }
}

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

sub handle_error {
   my ($self, $node) = @_;
   my $error = Net::XMPP2::Error::Stream->new (node => $node);

   $self->event (stream_error     => $error);
   $self->{writer}->send_end_of_stream;
}

=head2 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 L<Net::XMPP2::Writer::send_presence>.

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_presence {
   my ($self, $type, $create_cb, %attrs) = @_;
   my $id = $self->{iq_id}++;
   $self->{writer}->send_presence ($id, $type, $create_cb, %attrs);
   $id
}

=head2 send_message ($to, $type, $create_cb, %attrs)

This method sends a presence stanza, for the meanings
of C<$to>, C<$type>, C<$create_cb> and C<%attrs> please take a look
at the documentation for L<Net::XMPP2::Writer::send_message>.

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 = $self->{iq_id}++;
   $self->{writer}->send_message ($id, $to, $type, $create_cb, %attrs);
   $id
}

=head2 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}) {
               $w->startTag ([xmpp_ns ('bind'), 'bind']);
                  $w->startTag ([xmpp_ns ('bind'), 'resource']);
                  $w->characters ($self->{resource});
                  $w->endTag;
               $w->endTag;
            } else {
               $w->emptyTag ([xmpp_ns ('bind'), 'bind'])
            }
         },
         sub {
            my ($ret_iq, $error, $err) = @_;

            if ($err) {
               my ($res) = $error->xml_node ()->find_all ([qw/bind bind/], [qw/bind resource/]);
               $self->event (bind_error => $error, ($res ? $res : $self->{resource}));

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

=head2 jid

After the stream has been bound to a resource the JID can be retrieved via this
method.

=cut

sub jid { $_[0]->{jid} }

=head2 features

Returns the last received <features> tag in form of an L<Net::XMPP2::Node> object.

=cut

sub features { $_[0]->{features} }

#sub enable_extension {
#   my ($self, @exts) = @_;
#   for (@exts) {
#      if (/^xep-(\d+)$/i) {
#         $self->{ext}->{''.(1*$1)} = 1;
#      }
#   }
#}
#
#sub check_extension {
#   my ($self, $extnum) = @_;
#   return $self->{ext}->{"$extnum"} || $Net::XMPP2::EXTENSION_ENABLED{"$extnum"};
#}

=head1 EVENTS

These events can be registered on with C<reg_cb>:

=over 4

=item stream_features => $node

This event is sent when a stream feature (<features>) tag is received. C<$node> is the
L<Net::XMPP2::Node> object that represents the <features> tag.

=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 stream_error => $error

This event is sent if a XML stream error occured. C<$error>
is a L<Net::XMPP2::Error::Stream> 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 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<Net::XMPP2::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 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 connection was lost or another error
occured while writing or reading from it.

C<$message> is a humand 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 presence_xml => $node

This event is sent when a presence stanza is received. C<$node> is the
L<Net::XMPP2::Node> object that represents the <presence> tag.

=item message_xml => $node

This event is sent when a message stanza is received. C<$node> is the
L<Net::XMPP2::Node> object that represents the <message> tag.

=item iq_set_request_xml => $node, $handled_ref

=item iq_get_request_xml => $node, $handled_ref

These events are sent when an iq request stanza of type 'get' or 'set' is received.
C<$type> will either be 'get' or 'set' and C<$node> will be the L<Net::XMPP2::Node>
object of the iq tag.

If C<$$handled_ref> is true an event handler should not handle this message anymore.

If one of the event handlers handled this message the scalar pointed at by
the reference in C<$handled_ref> should be set to 1 true value. If C<$$handled_ref>
is still false after all event handlers were executed an error iq will be generated.

=back

=head1 AUTHOR

Robin Redeker, C<< <elmex at ta-sa.org> >>

=head1 COPYRIGHT & LICENSE

Copyright 2007 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; # End of Net::XMPP2
Revision:	1.11
Committed:	Sat Apr 21 13:51:39 2007 UTC (19 years, 5 months ago) by elmex
Branch:	MAIN
Changes since 1.10:	+24 -1 lines
Log Message:	implemented the (hopefully) last bits of important error reporting. Net::XMPP was released at the beginngin of this month - damn, i was too slow. But i've taken a look at their code. 17000 lines of code vs. my ~4500 LoC. Also their Java-API is really a mess...
#	User	Rev	Content
1	elmex	1.1	package Net::XMPP2::Connection;
2			use strict;
3			use AnyEvent;
4			use IO::Socket::INET;
5			use Net::XMPP2::Parser;
6			use Net::XMPP2::Writer;
7	elmex	1.10	use Net::XMPP2::Util qw/split_jid/;
8	elmex	1.9	use Net::XMPP2::Event;
9			use Net::XMPP2::SimpleConnection;
10	elmex	1.1	use Net::XMPP2::Namespaces qw/xmpp_ns/;
11	elmex	1.10	use Net::XMPP2::Error;
12	elmex	1.1	use Net::DNS;
13	elmex	1.2
14	elmex	1.9	our @ISA = qw/Net::XMPP2::SimpleConnection Net::XMPP2::Event/;
15	elmex	1.1
16			=head1 NAME
17
18			Net::XMPP2::Connection - A XML stream that implements the XMPP RFC 3920.
19
20			=head1 SYNOPSIS
21
22			use Net::XMPP2::Connection;
23
24			my $con =
25			Net::XMPP2::Connection->new (
26			username => "abc",
27			domain => "jabber.org",
28			resource => "Net::XMPP2"
29			);
30
31			$con->connect or die "Couldn't connect to jabber.org: $!";
32			$con->init;
33			$con->reg_cb (stream_ready => sub { print "XMPP stream ready!\n" });
34
35			=head1 DESCRIPTION
36
37			This module represents a XMPP stream as described in RFC 3920. You can issue the basic
38			XMPP XML stanzas with methods like C<send_iq>, C<send_message> and C<send_presence>.
39
40			And receive events with the C<reg_cb> event framework from the connection.
41
42			If you need instant messaging stuff please take a look at C<Net::XMPP2::IM::Connection>.
43
44			=head1 METHODS
45
46			=head2 new (%args)
47
48			Following arguments can be passed in C<%args>:
49
50			=over 4
51
52			=item language => $tag
53
54			This should be the language of the human readable contents that
55			will be transmitted over the stream. The default will be 'en'.
56
57			Please look in RFC 3066 how C<$tag> should look like.
58
59	elmex	1.10	=item jid => $jid
60
61			This can be used to set the settings C<username>, C<domain>
62			(and optionally C<resource>) from a C<$jid>.
63
64	elmex	1.1	=item resource => $resource
65
66			If this argument is given C<$resource> will be passed as desired
67			resource on resource binding.
68
69			Note: You have to take care that the stringprep profile for
70			resources can be applied at: C<$resource>. Otherwise the server
71			might signal an error. See L<Net::XMPP2::Util> for utility functions
72			to check this.
73
74			=item domain => $domain
75
76			This is the destination host we are going to connect to.
77			As the connection won't be automatically connected use C<connect>
78			to initiate the connect.
79
80			Note: A SRV RR lookup will be performed to discover the real hostname
81			and port to connect to. See also C<connect>.
82
83	elmex	1.9	=item override_host => $host
84			=item override_port => $port
85
86			This will be used as override to connect to.
87
88	elmex	1.1	=item port => $port
89
90			This is optional, the default port is 5222.
91
92			Note: A SRV RR lookup will be performed to discover the real hostname
93			and port to connect to. See also C<connect>.
94
95			=item username => $username
96
97			This is your C<$username> (the userpart in the JID);
98
99			Note: You have to take care that the stringprep profile for
100			nodes can be applied at: C<$username>. Otherwise the server
101			might signal an error. See L<Net::XMPP2::Util> for utility functions
102			to check this.
103
104			=item password => $password
105
106			This is the password for the C<username> above.
107
108	elmex	1.5	=item disable_ssl => $bool
109
110			If C<$bool> is true no SSL will be used.
111
112	elmex	1.1	=back
113
114			=cut
115
116			sub new {
117			my $this = shift;
118			my $class = ref($this) \|\| $this;
119			my $self = { language => 'en', @_ };
120			bless $self, $class;
121
122			$self->{parser} = new Net::XMPP2::Parser;
123			$self->{writer} = Net::XMPP2::Writer->new (
124			write_cb => sub { $self->write_data ($_[0]) }
125			);
126
127			$self->{parser}->set_stanza_cb (sub {
128			$self->handle_stanza (@_);
129			});
130
131			$self->{iq_id} = 1;
132
133			$self->{disconnect_cb} = sub {
134			my ($host, $port, $message) = @_;
135	elmex	1.7	delete $self->{authenticated};
136			delete $self->{ssl_enabled};
137	elmex	1.1	$self->event (disconnect => $host, $port, $message);
138			};
139
140	elmex	1.10	if ($self->{jid}) {
141			my ($user, $host, $res) = split_jid ($self->{jid});
142			$self->{username} = $user;
143			$self->{domain} = $host;
144			$self->{resource} = $res if defined $res;
145			}
146
147	elmex	1.7	for (qw/username password domain/) {
148			die "No '$_' argument given to new, but '$_' is required\n"
149			unless $self->{$_};
150			}
151
152	elmex	1.1	return $self;
153			}
154
155			=head2 connect ($no_srv_rr)
156
157			Try to connect to the domain and port passed in C<new>.
158
159			A SRV RR lookup will be performed on the domain to discover
160			the host and port to use. If you don't want this set C<$no_srv_rr>
161			to a true value. C<$no_srv_rr> is false by default.
162
163			As the SRV RR lookup might return multiple host and you fail to
164			connect to one you might just call this function again to try a
165			different host.
166
167			If C<connect> was successful and we connected a true value is returned.
168			If the connect was unsuccessful undef is returned and C<$!> will be set
169			to the error that occured while connecting.
170
171			If you want to know whether further connection attempts might be more
172			successful (as SRV RR lookup may return multiple hosts) call C<may_try_connect>
173			(see also C<may_try_connect>).
174
175			Note that an internal list will be kept of tried hosts. Use
176			C<reset_connect_tries> to reset the internal list of tried hosts.
177
178			=cut
179
180			sub connect {
181			my ($self, $no_srv_rr) = @_;
182
183			my ($host, $port) = ($self->{domain}, $self->{port} \|\| 5222);
184	elmex	1.9	if ($self->{override_host}) {
185			($host, $port) = ($self->{override_host}, $self->{override_port} \|\| 5222);
186	elmex	1.1
187	elmex	1.9	} else {
188			unless ($no_srv_rr) {
189			my $res = Net::DNS::Resolver->new;
190			my $p = $res->query ('_xmpp-client._tcp.'.$host, 'SRV');
191			if ($p) {
192			my @srvs = grep { $_->type eq 'SRV' } $p->answer;
193			if (@srvs) {
194			@srvs = sort { $a->priority <=> $b->priority } @srvs;
195			@srvs = sort { $b->weight <=> $a->weight } @srvs; # TODO
196			$port = $srvs[0]->port;
197			$host = $srvs[0]->target;
198			}
199	elmex	1.1	}
200			}
201			}
202
203			if ($self->SUPER::connect ($host, $port)) {
204			$self->event (connect => $host, $port);
205			return 1;
206			} else {
207			return undef;
208			}
209			}
210
211			=head2 may_try_connect
212
213			Returns the number of left alternatives of hosts to connect to for the
214			domain passed to C<new>.
215
216			An internal list of tried hosts will be managed by C<connect> and those
217			hosts will be ignored by a SRV RR lookup (which will be done if you
218			call this function).
219
220			Use C<reset_connect_tries> to reset the internal list of tried hosts.
221
222			=cut
223
224			sub may_try_connect {
225			# TODO
226			}
227
228			=head2 reset_connect_tries
229
230			This function resets the internal list of tried hosts for C<connect>.
231			See also C<connect>.
232
233			=cut
234
235			sub reset_connect_tries {
236			# TODO
237			}
238
239			sub handle_data {
240			my ($self, $buf) = @_;
241			$self->event (debug_recv => $$buf);
242			$self->{parser}->feed (substr $$buf, 0, (length $$buf), '');
243			}
244
245	elmex	1.5	sub debug_wrote_data {
246			my ($self, $data) = @_;
247			$self->event (debug_send => $data);
248			}
249
250	elmex	1.1	sub write_data {
251			my ($self, $data) = @_;
252			$self->SUPER::write_data ($data);
253			}
254
255			sub handle_stanza {
256			my ($self, $p, $node) = @_;
257
258			if ($node->eq (stream => 'features')) {
259			$self->event (stream_features => $node);
260			$self->handle_stream_features ($node);
261	elmex	1.4	$self->{features} = $node;
262	elmex	1.5
263	elmex	1.2	} elsif ($node->eq (tls => 'proceed')) {
264			$self->enable_ssl;
265			$self->{parser}->init;
266			$self->{writer}->init;
267			$self->{writer}->send_init_stream ($self->{language}, $self->{domain});
268
269	elmex	1.11	} elsif ($node->eq (tls => 'failure')) {
270			$self->event ('tls_error');
271			$self->disconnect ('TLS failure on TLS negotiation.');
272
273	elmex	1.1	} elsif ($node->eq (sasl => 'challenge')) {
274			$self->handle_sasl_challenge ($node);
275	elmex	1.11
276	elmex	1.1	} elsif ($node->eq (sasl => 'success')) {
277			$self->handle_sasl_success ($node);
278	elmex	1.11
279			} elsif ($node->eq (sasl => 'failure')) {
280			my $error = Net::XMPP2::Error::SASL->new (node => $node);
281			$self->event (sasl_error => $error);
282
283	elmex	1.1	} elsif ($node->eq (client => 'iq')) {
284			$self->handle_iq ($node);
285	elmex	1.11
286	elmex	1.4	} elsif ($node->eq (client => 'message')) {
287	elmex	1.6	$self->event (message_xml => $node);
288	elmex	1.11
289	elmex	1.4	} elsif ($node->eq (client => 'presence')) {
290	elmex	1.6	$self->event (presence_xml => $node);
291	elmex	1.11
292	elmex	1.1	} elsif ($node->eq (stream => 'error')) {
293			$self->handle_error ($node);
294	elmex	1.11
295	elmex	1.1	} else {
296			warn "Didn't understood stanza: '" . $node->name . "'";
297			}
298			}
299
300	elmex	1.10	=head2 init ()
301	elmex	1.1
302			Initiate the XML stream.
303
304			=cut
305
306			sub init {
307			my ($self) = @_;
308			$self->{writer}->send_init_stream ($self->{language}, $self->{domain});
309			}
310
311	elmex	1.10	=head2 is_connected ()
312
313			Returns true if the connection is still connected and stanzas can be
314			sent.
315
316			=cut
317
318			sub is_connected {
319			my ($self) = @_;
320			$self->{authenticated}
321			}
322
323	elmex	1.1	=head2 send_iq ($type, $create_cb, $result_cb, %attrs)
324
325			This method sends an IQ XMPP request.
326
327			Please take a look at the documentation for C<send_iq> in Net::XMPP2::Writer
328			about the meaning of C<$type>, C<$create_cb> and C<%attrs>.
329
330	elmex	1.4	C<$result_cb> will be called when a result was received. The first argument to
331			C<$result_cb> will be a Net::XMPP2::Node instance containing the IQ result
332			stanza contents.
333	elmex	1.1
334			If the IQ resulted in a stanza error the second argument to C<$result_cb> will
335			be C<undef> (if the error type was not 'continue') and the third argument will
336	elmex	1.10	be a L<Net::XMPP2::Error::IQ> object.
337	elmex	1.1
338	elmex	1.4	This method returns the newly generated id for this iq request.
339
340	elmex	1.1	=cut
341
342			sub send_iq {
343			my ($self, $type, $create_cb, $result_cb, %attrs) = @_;
344			my $id = $self->{iq_id}++;
345			$self->{iqs}->{$id} = $result_cb;
346			$self->{writer}->send_iq ($id, $type, $create_cb, %attrs);
347	elmex	1.4	$id
348			}
349
350			=head2 reply_iq_result ($req_iq_node, $create_cb, %attrs)
351
352			This method will generate a result reply to the iq request C<Net::XMPP2::Node>
353			in C<$req_iq_node>.
354
355			Please take a look at the documentation for C<send_iq> in Net::XMPP2::Writer
356			about the meaning C<$create_cb> and C<%attrs>.
357
358	elmex	1.6	Use C<$create_cb> to create the XML for the result.
359
360	elmex	1.4	The type for this iq reply is 'result'.
361
362			=cut
363
364			sub reply_iq_result {
365			my ($self, $iqnode, $create_cb, %attrs) = @_;
366			$self->{writer}->send_iq ($iqnode->attr ('id'), 'result', $create_cb, %attrs);
367			}
368
369			=head2 reply_iq_error ($req_iq_node, $error_type, $error, %attrs)
370
371			This method will generate an error reply to the iq request C<Net::XMPP2::Node>
372			in C<$req_iq_node>.
373
374			C<$error_type> is one of 'cancel', 'continue', 'modify', 'auth' and 'wait'.
375			C<$error> is one of the defined error conditions described in
376			L<Net::XMPP2::Writer::write_error_tag>.
377
378			Please take a look at the documentation for C<send_iq> in Net::XMPP2::Writer
379	elmex	1.6	about the meaning of C<%attrs>.
380	elmex	1.4
381			The type for this iq reply is 'error'.
382
383			=cut
384
385			sub reply_iq_error {
386			my ($self, $iqnode, $errtype, $error, %attrs) = @_;
387
388			$self->{writer}->send_iq (
389			$iqnode->attr ('id'), 'error',
390			sub { $self->{writer}->write_error_tag ($iqnode, $errtype, $error) },
391			%attrs
392			);
393	elmex	1.1	}
394
395			sub handle_iq {
396			my ($self, $node) = @_;
397
398	elmex	1.4	my $type = $node->attr ('type');
399
400			if ($type eq 'result') {
401			if (my $cb = delete $self->{iqs}->{$node->attr ('id')}) {
402	elmex	1.1	$cb->($node);
403			}
404	elmex	1.9
405	elmex	1.4	} elsif ($type eq 'error') {
406			if (my $cb = delete $self->{iqs}->{$node->attr ('id')}) {
407	elmex	1.1
408	elmex	1.10	my $error = Net::XMPP2::Error::IQ->new (node => $node);
409			$cb->(($error->type eq 'continue' ? $node : undef), $error);
410	elmex	1.1	}
411	elmex	1.4
412			} else {
413			my $handled = 0;
414	elmex	1.6	$self->event ("iq_${type}_request_xml" => $node, \$handled);
415	elmex	1.4
416			my @from;
417			push @from, (to => $node->attr ('from')) if $node->attr ('from');
418
419			unless ($handled) {
420	elmex	1.5	$self->reply_iq_error ($node, undef, 'feature-not-implemented', @from);
421	elmex	1.4	}
422	elmex	1.1	}
423			}
424
425			sub handle_stream_features {
426			my ($self, $node) = @_;
427			my @mechs = $node->find_all ([qw/sasl mechanisms/], [qw/sasl mechanism/]);
428			my @bind = $node->find_all ([qw/bind bind/]);
429	elmex	1.2	my @tls = $node->find_all ([qw/tls starttls/]);
430	elmex	1.1
431	elmex	1.5	if (not ($self->{disable_ssl}) && not ($self->{ssl_enabled}) && @tls) {
432	elmex	1.2	$self->{writer}->send_starttls;
433
434			} elsif (not ($self->{authenticated}) and @mechs) {
435	elmex	1.1	$self->{writer}->send_sasl_auth (
436			(join ' ', map { $_->text } @mechs),
437			$self->{username}, $self->{domain}, $self->{password}
438			);
439
440			} elsif (@bind) {
441			$self->do_rebind ($self->{resource});
442			}
443			}
444
445			sub handle_sasl_challenge {
446			my ($self, $node) = @_;
447			$self->{writer}->send_sasl_response ($node->text);
448			}
449
450			sub handle_sasl_success {
451			my ($self, $node) = @_;
452			$self->{authenticated} = 1;
453			$self->{parser}->init;
454			$self->{writer}->init;
455			$self->{writer}->send_init_stream ($self->{language}, $self->{domain});
456			}
457
458			sub handle_error {
459			my ($self, $node) = @_;
460	elmex	1.10	my $error = Net::XMPP2::Error::Stream->new (node => $node);
461
462			$self->event (stream_error => $error);
463	elmex	1.1	$self->{writer}->send_end_of_stream;
464			}
465
466	elmex	1.4	=head2 send_presence ($type, $create_cb, %attrs)
467
468			This method sends a presence stanza, for the meanings
469			of C<$type>, C<$create_cb> and C<%attrs> please take a look
470			at the documentation for L<Net::XMPP2::Writer::send_presence>.
471
472			This methods does attach an id attribute to the message stanza and
473			will return the id that was used (so you can react on possible replies).
474
475			=cut
476
477			sub send_presence {
478			my ($self, $type, $create_cb, %attrs) = @_;
479			my $id = $self->{iq_id}++;
480			$self->{writer}->send_presence ($id, $type, $create_cb, %attrs);
481			$id
482			}
483
484			=head2 send_message ($to, $type, $create_cb, %attrs)
485
486			This method sends a presence stanza, for the meanings
487			of C<$to>, C<$type>, C<$create_cb> and C<%attrs> please take a look
488			at the documentation for L<Net::XMPP2::Writer::send_message>.
489
490			This methods does attach an id attribute to the message stanza and
491			will return the id that was used (so you can react on possible replies).
492
493			=cut
494
495			sub send_message {
496			my ($self, $to, $type, $create_cb, %attrs) = @_;
497			my $id = $self->{iq_id}++;
498			$self->{writer}->send_message ($id, $to, $type, $create_cb, %attrs);
499			$id
500			}
501
502	elmex	1.1	=head2 do_rebind ($resource)
503
504			In case you got a C<bind_error> event and want to retry
505			binding you can call this function to set a new C<$resource>
506			and retry binding.
507
508			If it fails again you can call this again. Becareful not to
509			end up in a loop!
510
511			If binding was successful the C<stream_ready> event will be generated.
512
513			=cut
514
515			sub do_rebind {
516			my ($self, $resource) = @_;
517			$self->{resource} = $resource;
518			$self->send_iq (
519			set =>
520			sub {
521			my ($w) = @_;
522			if ($self->{resource}) {
523			$w->startTag ([xmpp_ns ('bind'), 'bind']);
524			$w->startTag ([xmpp_ns ('bind'), 'resource']);
525			$w->characters ($self->{resource});
526			$w->endTag;
527			$w->endTag;
528			} else {
529			$w->emptyTag ([xmpp_ns ('bind'), 'bind'])
530			}
531			},
532			sub {
533	elmex	1.10	my ($ret_iq, $error, $err) = @_;
534	elmex	1.1
535			if ($err) {
536	elmex	1.10	my ($res) = $error->xml_node ()->find_all ([qw/bind bind/], [qw/bind resource/]);
537			$self->event (bind_error => $error, ($res ? $res : $self->{resource}));
538	elmex	1.1
539			} else {
540			my @jid = $ret_iq->find_all ([qw/bind bind/], [qw/bind jid/]);
541			my $jid = $jid[0]->text;
542			unless ($jid) { die "Got empty JID tag from server!\n" }
543			$self->{jid} = $jid;
544
545			$self->event (stream_ready => $jid);
546			}
547			}
548			);
549			}
550
551			=head2 jid
552
553			After the stream has been bound to a resource the JID can be retrieved via this
554			method.
555
556			=cut
557
558			sub jid { $_[0]->{jid} }
559
560	elmex	1.4	=head2 features
561
562			Returns the last received <features> tag in form of an L<Net::XMPP2::Node> object.
563
564			=cut
565
566			sub features { $_[0]->{features} }
567
568			#sub enable_extension {
569			# my ($self, @exts) = @_;
570			# for (@exts) {
571			# if (/^xep-(\d+)$/i) {
572			# $self->{ext}->{''.(1*$1)} = 1;
573			# }
574			# }
575			#}
576			#
577			#sub check_extension {
578			# my ($self, $extnum) = @_;
579			# return $self->{ext}->{"$extnum"} \|\| $Net::XMPP2::EXTENSION_ENABLED{"$extnum"};
580			#}
581
582	elmex	1.1	=head1 EVENTS
583
584			These events can be registered on with C<reg_cb>:
585
586			=over 4
587
588	elmex	1.11	=item stream_features => $node
589	elmex	1.1
590	elmex	1.4	This event is sent when a stream feature (<features>) tag is received. C<$node> is the
591			L<Net::XMPP2::Node> object that represents the <features> tag.
592	elmex	1.1
593			=item stream_ready => $jid
594
595			This event is sent if the XML stream has been established (and
596			resources have been bound) and is ready for transmitting regular stanzas.
597
598			C<$jid> is the bound jabber id.
599
600	elmex	1.10	=item stream_error => $error
601	elmex	1.6
602			This event is sent if a XML stream error occured. C<$error>
603	elmex	1.10	is a L<Net::XMPP2::Error::Stream> object.
604	elmex	1.6
605	elmex	1.11	=item tls_error
606
607			This event is emitted when a TLS error occured on TLS negotiation.
608			After this the connection will be disconnected.
609
610			=item sasl_error => $error
611
612			This event is emitted on SASL authentication error.
613
614	elmex	1.10	=item bind_error => $error, $resource
615	elmex	1.6
616	elmex	1.10	This event is generated when the stream was unable to bind to
617			any or the in C<new> specified resource. C<$error> is a L<Net::XMPP2::Error::IQ>
618			object. C<$resource> is the errornous resource string or undef if none
619			was received.
620	elmex	1.6
621	elmex	1.10	The C<condition> of the C<$error> might be one of: 'bad-request',
622			'not-allowed' or 'conflict'.
623	elmex	1.1
624			Node: this is untested, i couldn't get the server to send a bind error
625			to test this.
626
627			=item connect => $host, $port
628
629			This event is generated when a successful connect was performed to
630			the domain passed to C<new>.
631
632			Note: C<$host> and C<$port> might be different from the domain you passed to
633			C<new> if C<connect> performed a SRV RR lookup.
634
635			If this connection is lost a C<disconnect> will be generated with the same
636			C<$host> and C<$port>.
637
638			=item disconnect => $host, $port, $message
639
640			This event is generated when the connection was lost or another error
641			occured while writing or reading from it.
642
643			C<$message> is a humand readable error message for the failure.
644			C<$host> and C<$port> were the host and port we were connected to.
645
646			Note: C<$host> and C<$port> might be different from the domain you passed to
647			C<new> if C<connect> performed a SRV RR lookup.
648
649	elmex	1.6	=item presence_xml => $node
650	elmex	1.4
651			This event is sent when a presence stanza is received. C<$node> is the
652			L<Net::XMPP2::Node> object that represents the <presence> tag.
653
654	elmex	1.6	=item message_xml => $node
655	elmex	1.4
656			This event is sent when a message stanza is received. C<$node> is the
657			L<Net::XMPP2::Node> object that represents the <message> tag.
658
659	elmex	1.6	=item iq_set_request_xml => $node, $handled_ref
660	elmex	1.4
661	elmex	1.6	=item iq_get_request_xml => $node, $handled_ref
662	elmex	1.4
663			These events are sent when an iq request stanza of type 'get' or 'set' is received.
664			C<$type> will either be 'get' or 'set' and C<$node> will be the L<Net::XMPP2::Node>
665			object of the iq tag.
666
667			If C<$$handled_ref> is true an event handler should not handle this message anymore.
668
669			If one of the event handlers handled this message the scalar pointed at by
670			the reference in C<$handled_ref> should be set to 1 true value. If C<$$handled_ref>
671			is still false after all event handlers were executed an error iq will be generated.
672
673	elmex	1.1	=back
674
675			=head1 AUTHOR
676
677			Robin Redeker, C<< <elmex at ta-sa.org> >>
678
679			=head1 COPYRIGHT & LICENSE
680
681			Copyright 2007 Robin Redeker, all rights reserved.
682
683			This program is free software; you can redistribute it and/or modify it
684			under the same terms as Perl itself.
685
686			=cut
687
688			1; # End of Net::XMPP2