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 (sasl => 'challenge')) {
      $self->handle_sasl_challenge ($node);
   } elsif ($node->eq (sasl => 'success')) {
      $self->handle_sasl_success ($node);
   } 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_xml => $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 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.10
Committed:	Fri Apr 20 14:56:45 2007 UTC (19 years, 5 months ago) by elmex
Branch:	MAIN
Changes since 1.9:	+45 -118 lines
Log Message:	implemented Client.pm. Implemented error objects which simplyfied the error reporting.
#	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.1	} elsif ($node->eq (sasl => 'challenge')) {
270			$self->handle_sasl_challenge ($node);
271			} elsif ($node->eq (sasl => 'success')) {
272			$self->handle_sasl_success ($node);
273			} elsif ($node->eq (client => 'iq')) {
274			$self->handle_iq ($node);
275	elmex	1.4	} elsif ($node->eq (client => 'message')) {
276	elmex	1.6	$self->event (message_xml => $node);
277	elmex	1.4	} elsif ($node->eq (client => 'presence')) {
278	elmex	1.6	$self->event (presence_xml => $node);
279	elmex	1.1	} elsif ($node->eq (stream => 'error')) {
280			$self->handle_error ($node);
281			} else {
282			warn "Didn't understood stanza: '" . $node->name . "'";
283			}
284			}
285
286	elmex	1.10	=head2 init ()
287	elmex	1.1
288			Initiate the XML stream.
289
290			=cut
291
292			sub init {
293			my ($self) = @_;
294			$self->{writer}->send_init_stream ($self->{language}, $self->{domain});
295			}
296
297	elmex	1.10	=head2 is_connected ()
298
299			Returns true if the connection is still connected and stanzas can be
300			sent.
301
302			=cut
303
304			sub is_connected {
305			my ($self) = @_;
306			$self->{authenticated}
307			}
308
309	elmex	1.1	=head2 send_iq ($type, $create_cb, $result_cb, %attrs)
310
311			This method sends an IQ XMPP request.
312
313			Please take a look at the documentation for C<send_iq> in Net::XMPP2::Writer
314			about the meaning of C<$type>, C<$create_cb> and C<%attrs>.
315
316	elmex	1.4	C<$result_cb> will be called when a result was received. The first argument to
317			C<$result_cb> will be a Net::XMPP2::Node instance containing the IQ result
318			stanza contents.
319	elmex	1.1
320			If the IQ resulted in a stanza error the second argument to C<$result_cb> will
321			be C<undef> (if the error type was not 'continue') and the third argument will
322	elmex	1.10	be a L<Net::XMPP2::Error::IQ> object.
323	elmex	1.1
324	elmex	1.4	This method returns the newly generated id for this iq request.
325
326	elmex	1.1	=cut
327
328			sub send_iq {
329			my ($self, $type, $create_cb, $result_cb, %attrs) = @_;
330			my $id = $self->{iq_id}++;
331			$self->{iqs}->{$id} = $result_cb;
332			$self->{writer}->send_iq ($id, $type, $create_cb, %attrs);
333	elmex	1.4	$id
334			}
335
336			=head2 reply_iq_result ($req_iq_node, $create_cb, %attrs)
337
338			This method will generate a result reply to the iq request C<Net::XMPP2::Node>
339			in C<$req_iq_node>.
340
341			Please take a look at the documentation for C<send_iq> in Net::XMPP2::Writer
342			about the meaning C<$create_cb> and C<%attrs>.
343
344	elmex	1.6	Use C<$create_cb> to create the XML for the result.
345
346	elmex	1.4	The type for this iq reply is 'result'.
347
348			=cut
349
350			sub reply_iq_result {
351			my ($self, $iqnode, $create_cb, %attrs) = @_;
352			$self->{writer}->send_iq ($iqnode->attr ('id'), 'result', $create_cb, %attrs);
353			}
354
355			=head2 reply_iq_error ($req_iq_node, $error_type, $error, %attrs)
356
357			This method will generate an error reply to the iq request C<Net::XMPP2::Node>
358			in C<$req_iq_node>.
359
360			C<$error_type> is one of 'cancel', 'continue', 'modify', 'auth' and 'wait'.
361			C<$error> is one of the defined error conditions described in
362			L<Net::XMPP2::Writer::write_error_tag>.
363
364			Please take a look at the documentation for C<send_iq> in Net::XMPP2::Writer
365	elmex	1.6	about the meaning of C<%attrs>.
366	elmex	1.4
367			The type for this iq reply is 'error'.
368
369			=cut
370
371			sub reply_iq_error {
372			my ($self, $iqnode, $errtype, $error, %attrs) = @_;
373
374			$self->{writer}->send_iq (
375			$iqnode->attr ('id'), 'error',
376			sub { $self->{writer}->write_error_tag ($iqnode, $errtype, $error) },
377			%attrs
378			);
379	elmex	1.1	}
380
381			sub handle_iq {
382			my ($self, $node) = @_;
383
384	elmex	1.4	my $type = $node->attr ('type');
385
386			if ($type eq 'result') {
387			if (my $cb = delete $self->{iqs}->{$node->attr ('id')}) {
388	elmex	1.1	$cb->($node);
389			}
390	elmex	1.9
391	elmex	1.4	} elsif ($type eq 'error') {
392			if (my $cb = delete $self->{iqs}->{$node->attr ('id')}) {
393	elmex	1.1
394	elmex	1.10	my $error = Net::XMPP2::Error::IQ->new (node => $node);
395			$cb->(($error->type eq 'continue' ? $node : undef), $error);
396	elmex	1.1	}
397	elmex	1.4
398			} else {
399			my $handled = 0;
400	elmex	1.6	$self->event ("iq_${type}_request_xml" => $node, \$handled);
401	elmex	1.4
402			my @from;
403			push @from, (to => $node->attr ('from')) if $node->attr ('from');
404
405			unless ($handled) {
406	elmex	1.5	$self->reply_iq_error ($node, undef, 'feature-not-implemented', @from);
407	elmex	1.4	}
408	elmex	1.1	}
409			}
410
411			sub handle_stream_features {
412			my ($self, $node) = @_;
413			my @mechs = $node->find_all ([qw/sasl mechanisms/], [qw/sasl mechanism/]);
414			my @bind = $node->find_all ([qw/bind bind/]);
415	elmex	1.2	my @tls = $node->find_all ([qw/tls starttls/]);
416	elmex	1.1
417	elmex	1.5	if (not ($self->{disable_ssl}) && not ($self->{ssl_enabled}) && @tls) {
418	elmex	1.2	$self->{writer}->send_starttls;
419
420			} elsif (not ($self->{authenticated}) and @mechs) {
421	elmex	1.1	$self->{writer}->send_sasl_auth (
422			(join ' ', map { $_->text } @mechs),
423			$self->{username}, $self->{domain}, $self->{password}
424			);
425
426			} elsif (@bind) {
427			$self->do_rebind ($self->{resource});
428			}
429			}
430
431			sub handle_sasl_challenge {
432			my ($self, $node) = @_;
433			$self->{writer}->send_sasl_response ($node->text);
434			}
435
436			sub handle_sasl_success {
437			my ($self, $node) = @_;
438			$self->{authenticated} = 1;
439			$self->{parser}->init;
440			$self->{writer}->init;
441			$self->{writer}->send_init_stream ($self->{language}, $self->{domain});
442			}
443
444			sub handle_error {
445			my ($self, $node) = @_;
446	elmex	1.10	my $error = Net::XMPP2::Error::Stream->new (node => $node);
447
448			$self->event (stream_error => $error);
449	elmex	1.1	$self->{writer}->send_end_of_stream;
450			}
451
452	elmex	1.4	=head2 send_presence ($type, $create_cb, %attrs)
453
454			This method sends a presence stanza, for the meanings
455			of C<$type>, C<$create_cb> and C<%attrs> please take a look
456			at the documentation for L<Net::XMPP2::Writer::send_presence>.
457
458			This methods does attach an id attribute to the message stanza and
459			will return the id that was used (so you can react on possible replies).
460
461			=cut
462
463			sub send_presence {
464			my ($self, $type, $create_cb, %attrs) = @_;
465			my $id = $self->{iq_id}++;
466			$self->{writer}->send_presence ($id, $type, $create_cb, %attrs);
467			$id
468			}
469
470			=head2 send_message ($to, $type, $create_cb, %attrs)
471
472			This method sends a presence stanza, for the meanings
473			of C<$to>, C<$type>, C<$create_cb> and C<%attrs> please take a look
474			at the documentation for L<Net::XMPP2::Writer::send_message>.
475
476			This methods does attach an id attribute to the message stanza and
477			will return the id that was used (so you can react on possible replies).
478
479			=cut
480
481			sub send_message {
482			my ($self, $to, $type, $create_cb, %attrs) = @_;
483			my $id = $self->{iq_id}++;
484			$self->{writer}->send_message ($id, $to, $type, $create_cb, %attrs);
485			$id
486			}
487
488	elmex	1.1	=head2 do_rebind ($resource)
489
490			In case you got a C<bind_error> event and want to retry
491			binding you can call this function to set a new C<$resource>
492			and retry binding.
493
494			If it fails again you can call this again. Becareful not to
495			end up in a loop!
496
497			If binding was successful the C<stream_ready> event will be generated.
498
499			=cut
500
501			sub do_rebind {
502			my ($self, $resource) = @_;
503			$self->{resource} = $resource;
504			$self->send_iq (
505			set =>
506			sub {
507			my ($w) = @_;
508			if ($self->{resource}) {
509			$w->startTag ([xmpp_ns ('bind'), 'bind']);
510			$w->startTag ([xmpp_ns ('bind'), 'resource']);
511			$w->characters ($self->{resource});
512			$w->endTag;
513			$w->endTag;
514			} else {
515			$w->emptyTag ([xmpp_ns ('bind'), 'bind'])
516			}
517			},
518			sub {
519	elmex	1.10	my ($ret_iq, $error, $err) = @_;
520	elmex	1.1
521			if ($err) {
522	elmex	1.10	my ($res) = $error->xml_node ()->find_all ([qw/bind bind/], [qw/bind resource/]);
523			$self->event (bind_error => $error, ($res ? $res : $self->{resource}));
524	elmex	1.1
525			} else {
526			my @jid = $ret_iq->find_all ([qw/bind bind/], [qw/bind jid/]);
527			my $jid = $jid[0]->text;
528			unless ($jid) { die "Got empty JID tag from server!\n" }
529			$self->{jid} = $jid;
530
531			$self->event (stream_ready => $jid);
532			}
533			}
534			);
535			}
536
537			=head2 jid
538
539			After the stream has been bound to a resource the JID can be retrieved via this
540			method.
541
542			=cut
543
544			sub jid { $_[0]->{jid} }
545
546	elmex	1.4	=head2 features
547
548			Returns the last received <features> tag in form of an L<Net::XMPP2::Node> object.
549
550			=cut
551
552			sub features { $_[0]->{features} }
553
554			#sub enable_extension {
555			# my ($self, @exts) = @_;
556			# for (@exts) {
557			# if (/^xep-(\d+)$/i) {
558			# $self->{ext}->{''.(1*$1)} = 1;
559			# }
560			# }
561			#}
562			#
563			#sub check_extension {
564			# my ($self, $extnum) = @_;
565			# return $self->{ext}->{"$extnum"} \|\| $Net::XMPP2::EXTENSION_ENABLED{"$extnum"};
566			#}
567
568	elmex	1.1	=head1 EVENTS
569
570			These events can be registered on with C<reg_cb>:
571
572			=over 4
573
574	elmex	1.6	=item stream_features_xml => $node
575	elmex	1.1
576	elmex	1.4	This event is sent when a stream feature (<features>) tag is received. C<$node> is the
577			L<Net::XMPP2::Node> object that represents the <features> tag.
578	elmex	1.1
579			=item stream_ready => $jid
580
581			This event is sent if the XML stream has been established (and
582			resources have been bound) and is ready for transmitting regular stanzas.
583
584			C<$jid> is the bound jabber id.
585
586	elmex	1.10	=item stream_error => $error
587	elmex	1.6
588			This event is sent if a XML stream error occured. C<$error>
589	elmex	1.10	is a L<Net::XMPP2::Error::Stream> object.
590	elmex	1.6
591	elmex	1.10	=item bind_error => $error, $resource
592	elmex	1.6
593	elmex	1.10	This event is generated when the stream was unable to bind to
594			any or the in C<new> specified resource. C<$error> is a L<Net::XMPP2::Error::IQ>
595			object. C<$resource> is the errornous resource string or undef if none
596			was received.
597	elmex	1.6
598	elmex	1.10	The C<condition> of the C<$error> might be one of: 'bad-request',
599			'not-allowed' or 'conflict'.
600	elmex	1.1
601			Node: this is untested, i couldn't get the server to send a bind error
602			to test this.
603
604			=item connect => $host, $port
605
606			This event is generated when a successful connect was performed to
607			the domain passed to C<new>.
608
609			Note: C<$host> and C<$port> might be different from the domain you passed to
610			C<new> if C<connect> performed a SRV RR lookup.
611
612			If this connection is lost a C<disconnect> will be generated with the same
613			C<$host> and C<$port>.
614
615			=item disconnect => $host, $port, $message
616
617			This event is generated when the connection was lost or another error
618			occured while writing or reading from it.
619
620			C<$message> is a humand readable error message for the failure.
621			C<$host> and C<$port> were the host and port we were connected to.
622
623			Note: C<$host> and C<$port> might be different from the domain you passed to
624			C<new> if C<connect> performed a SRV RR lookup.
625
626	elmex	1.6	=item presence_xml => $node
627	elmex	1.4
628			This event is sent when a presence stanza is received. C<$node> is the
629			L<Net::XMPP2::Node> object that represents the <presence> tag.
630
631	elmex	1.6	=item message_xml => $node
632	elmex	1.4
633			This event is sent when a message stanza is received. C<$node> is the
634			L<Net::XMPP2::Node> object that represents the <message> tag.
635
636	elmex	1.6	=item iq_set_request_xml => $node, $handled_ref
637	elmex	1.4
638	elmex	1.6	=item iq_get_request_xml => $node, $handled_ref
639	elmex	1.4
640			These events are sent when an iq request stanza of type 'get' or 'set' is received.
641			C<$type> will either be 'get' or 'set' and C<$node> will be the L<Net::XMPP2::Node>
642			object of the iq tag.
643
644			If C<$$handled_ref> is true an event handler should not handle this message anymore.
645
646			If one of the event handlers handled this message the scalar pointed at by
647			the reference in C<$handled_ref> should be set to 1 true value. If C<$$handled_ref>
648			is still false after all event handlers were executed an error iq will be generated.
649
650	elmex	1.1	=back
651
652			=head1 AUTHOR
653
654			Robin Redeker, C<< <elmex at ta-sa.org> >>
655
656			=head1 COPYRIGHT & LICENSE
657
658			Copyright 2007 Robin Redeker, all rights reserved.
659
660			This program is free software; you can redistribute it and/or modify it
661			under the same terms as Perl itself.
662
663			=cut
664
665			1; # End of Net::XMPP2